diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000000..1d0fefdf34 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,26 @@ +root = true + +[*] +charset = utf-8 + +[*.{ml,mli,mll,mly}, *.{js,jsx,ts,tsx,vue,json}] +max_line_length = 92 +trim_trailing_whitespace = true +insert_final_newline = true +indent_style = space +indent_size = 2 + +[*.{js,jsx,ts,tsx,vue,json}] +max_line_length = 92 +trim_trailing_whitespace = true +insert_final_newline = true +indent_style = space +indent_size = 2 + +[{Makefile, makefile, GNUmakefile}] +indent_style = tab +indent_size = 4 + +[Makefile.*] +indent_style = tab +indent_size = 4 diff --git a/.gitignore b/.gitignore index 94c31b8e73..93c417b2bd 100644 --- a/.gitignore +++ b/.gitignore @@ -61,6 +61,7 @@ reason/ man/ lib/ocaml bin/* +_opam *.exe odoc_gen/*.cmxs diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000000..784974d21f --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,13 @@ +margin = 80 + +parse-docstrings = true +wrap-comments = true + +field-space = loose +let-binding-spacing = sparse +module-item-spacing = preserve + +let-open = auto + +break-cases = fit-or-vertical +sequence-blank-line = preserve-one diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore new file mode 100644 index 0000000000..12d46a4376 --- /dev/null +++ b/.ocamlformat-ignore @@ -0,0 +1,4 @@ +# Files containing cppo directives that ocamlformat cannot parse +#jscomp/core/js_name_of_module_id.ml +#jscomp/core/js_cmj_load.ml +#jscomp/core/lam_compile_main.ml diff --git a/.prettierrc b/.prettierrc new file mode 100644 index 0000000000..34189fac70 --- /dev/null +++ b/.prettierrc @@ -0,0 +1,7 @@ +# Explicitly set to override .editorconfig with a lower value; see: +# +printWidth: 80 + +# Attempting to match existing style in the codebase +semi: false +singleQuote: true diff --git a/docs/docson/build-schema.json b/docs/docson/build-schema.json index f9523f6371..49b2fd38aa 100644 --- a/docs/docson/build-schema.json +++ b/docs/docson/build-schema.json @@ -18,6 +18,15 @@ "in-source": { "type": "boolean", "description": "Default: false." + }, + "suffix" : { + "enum" : [ + ".js", + ".mjs", + ".bs.js", + ".bs.mjs" + ], + "description": "suffix of generated JavaScript files, default varies by 'module' and 'in-source'" } }, "required": [ @@ -78,7 +87,7 @@ } } ] - + } }, "pp-specs": { @@ -139,7 +148,7 @@ "type": "string", "description": "name of the directory" }, - + "type": { "enum": [ "dev", @@ -379,7 +388,7 @@ }, "ignored-dirs" : { "type" : "array", - "items": { + "items": { "type" : "string" }, "description": "a list of directories that bsb will not look into" @@ -410,7 +419,7 @@ "gentypeconfig": { "$ref" : "#/definitions/gentype-specs", "description": "gentype config, see cristianoc/genType for more details" - }, + }, "bsc-flags": { "$ref": "#/definitions/bsc-flags", "description": "Flags passed to bsc.exe" @@ -482,13 +491,6 @@ "type": "string" }, "description": "(Not needed usually) arguments to pass to `refmt` above. Default: `[\"--print\", \"binary\"]`." - }, - "suffix" : { - "enum" : [ - ".js", - ".bs.js" - ], - "description": "suffix of generated js files, default to [.js] " } }, "additionalProperties": false, diff --git a/jscomp/bsb/bsb_build_schemas.ml b/jscomp/bsb/bsb_build_schemas.ml index 63e6198dbe..dd53ea4fc9 100644 --- a/jscomp/bsb/bsb_build_schemas.ml +++ b/jscomp/bsb/bsb_build_schemas.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,7 +17,7 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -75,11 +75,12 @@ let generators = "generators" let command = "command" let edge = "edge" let namespace = "namespace" +let _module = "module" let in_source = "in-source" +let suffix = "suffix" let warnings = "warnings" let number = "number" let error = "error" -let suffix = "suffix" let gentypeconfig = "gentypeconfig" let path = "path" -let ignored_dirs = "ignored-dirs" \ No newline at end of file +let ignored_dirs = "ignored-dirs" diff --git a/jscomp/bsb/bsb_config_parse.ml b/jscomp/bsb/bsb_config_parse.ml index 89917593ec..22e7cebe56 100644 --- a/jscomp/bsb/bsb_config_parse.ml +++ b/jscomp/bsb/bsb_config_parse.ml @@ -22,462 +22,437 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let get_list_string = Bsb_build_util.get_list_string -let (//) = Ext_path.combine +let ( // ) = Ext_path.combine let current_package : Bsb_pkg_types.t = Global Bs_version.package_name -let resolve_package cwd package_name = - let x = Bsb_pkg.resolve_bs_package ~cwd package_name in +let resolve_package cwd package_name = + let x = Bsb_pkg.resolve_bs_package ~cwd package_name in { - Bsb_config_types.package_name ; - package_install_path = x // Bsb_config.lib_ocaml + Bsb_config_types.package_name; + package_install_path = x // Bsb_config.lib_ocaml; } -type json_map = Ext_json_types.t Map_string.t -(* Key is the path *) -let (|?) m (key, cb) = - m |> Ext_json.test key cb +type json_map = Ext_json_types.t Map_string.t +(* Key is the path *) +let ( |? ) m (key, cb) = m |> Ext_json.test key cb -let extract_main_entries (map :json_map) = -#if BS_NATIVE then +let extract_main_entries (map : json_map) = +#if BS_NATIVE then let extract_entries (field : Ext_json_types.t array) = - Ext_array.to_list_map (function - | Ext_json_types.Obj {map} -> - (* kind defaults to bytecode *) - let kind = ref "js" in - let main = ref None in - let _ = map - |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x)) - |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x)) - in - let path = begin match !main with - (* This is technically optional when compiling to js *) - | None when !kind = Literals.js -> - "Index" - | None -> - failwith "Missing field 'main'. That field is required its value needs to be the main module for the target" - | Some path -> path - end in - if !kind = Literals.native then - Some (Bsb_config_types.NativeTarget path) - else if !kind = Literals.bytecode then - Some (Bsb_config_types.BytecodeTarget path) - else if !kind = Literals.js then - Some (Bsb_config_types.JsTarget path) - else - failwith "Missing field 'kind'. That field is required and its value be 'js', 'native' or 'bytecode'" - | _ -> failwith "Unrecognized object inside array 'entries' field.") - field in + Ext_array.to_list_map + (function + | Ext_json_types.Obj { map } -> + (* kind defaults to bytecode *) + let kind = ref "js" in + let main = ref None in + let _ = + map + |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x)) + |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x)) + in + let path = + match !main with + (* This is technically optional when compiling to js *) + | None when !kind = Literals.js -> "Index" + | None -> + failwith + "Missing field 'main'. That field is required its value \ + needs to be the main module for the target" + | Some path -> path + in + if !kind = Literals.native then + Some (Bsb_config_types.NativeTarget path) + else if !kind = Literals.bytecode then + Some (Bsb_config_types.BytecodeTarget path) + else if !kind = Literals.js then + Some (Bsb_config_types.JsTarget path) + else + failwith + "Missing field 'kind'. That field is required and its value be \ + 'js', 'native' or 'bytecode'" + | _ -> failwith "Unrecognized object inside array 'entries' field.") + field + in let entries = ref Bsb_default.main_entries in - begin match Map_string.find_opt map Bsb_build_schemas.entries with - | Some (Arr {content = s}) -> entries := extract_entries s - | _ -> () - end; !entries -#else - [] + ( match Map_string.find_opt map Bsb_build_schemas.entries with + | Some (Arr { content = s }) -> entries := extract_entries s + | _ -> () ); + !entries +#else + [] #end -let package_specs_from_bsconfig () = +let deprecated_extract_bs_suffix_exn (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | None -> None + | Some (Str { str } as config) -> + if str = Literals.suffix_js then Some false + else if str = Literals.suffix_bs_js then Some true + else + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports either `.js` or \ + `.bs.js`. Use 'suffix' under 'package-specs' instead." + | Some config -> + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports a string" + + +let package_specs_from_obj_map (map : json_map) = + let deprecated_bs_suffix = deprecated_extract_bs_suffix_exn map in + match Map_string.find_opt map Bsb_build_schemas.package_specs with + | Some x -> Bsb_package_specs.from_json ?deprecated_bs_suffix x + | None -> Bsb_package_specs.default_package_specs ?deprecated_bs_suffix () + + +let package_specs_from_bsconfig () = let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in - begin match json with - | Obj {map} -> - begin - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> - Bsb_package_specs.default_package_specs - end - | _ -> assert false - end - - - + match json with + | Obj { map } -> package_specs_from_obj_map map + | _ -> assert false (*TODO: it is a little mess that [cwd] and [project dir] are shared*) - -let extract_package_name_and_namespace - (map : json_map) : string * string option = - let package_name = - match Map_string.find_opt map Bsb_build_schemas.name with - - | Some (Str { str = "_" } as config) - -> - Bsb_exception.config_error config "_ is a reserved package name" - | Some (Str {str = name }) -> - name - | Some config -> - Bsb_exception.config_error config - "name expect a string field" - | None -> - Bsb_exception.invalid_spec - "field name is required" - in - let namespace = - match Map_string.find_opt map Bsb_build_schemas.namespace with - | None - | Some (False _) - -> None - | Some (True _) -> - Some (Ext_namespace.namespace_of_package_name package_name) - | Some (Str {str}) -> - (*TODO : check the validity of namespace *) - Some (Ext_namespace.namespace_of_package_name str) +let extract_package_name_and_namespace (map : json_map) : string * string option + = + let package_name = + match Map_string.find_opt map Bsb_build_schemas.name with + | Some (Str { str = "_" } as config) -> + Bsb_exception.config_error config "_ is a reserved package name" + | Some (Str { str = name }) -> name + | Some config -> + Bsb_exception.config_error config "name expect a string field" + | None -> Bsb_exception.invalid_spec "field name is required" + in + let namespace = + match Map_string.find_opt map Bsb_build_schemas.namespace with + | None | Some (False _) -> None + | Some (True _) -> + Some (Ext_namespace.namespace_of_package_name package_name) + | Some (Str { str }) -> + (*TODO : check the validity of namespace *) + Some (Ext_namespace.namespace_of_package_name str) | Some x -> - Bsb_exception.config_error x - "namespace field expects string or boolean" - in - package_name, namespace - - -(** - There are two things to check: - - the running bsb and vendoring bsb is the same - - the running bsb need delete stale build artifacts - (kinda check npm upgrade) -*) -let check_version_exit (map : json_map) stdlib_path = - match Map_string.find_exn map Bsb_build_schemas.version with - | Str {str } -> - if str <> Bs_version.version then - begin + Bsb_exception.config_error x "namespace field expects string or boolean" + in + (package_name, namespace) + + +(* There are two things to check: - the running bsb and vendoring bsb is the + same - the running bsb need delete stale build artifacts (kinda check npm + upgrade) *) +let check_version_exit (map : json_map) stdlib_path = + match Map_string.find_exn map Bsb_build_schemas.version with + | Str { str } -> + if str <> Bs_version.version then ( Format.fprintf Format.err_formatter - "@{bs-platform version mismatch@} Running bsb @{%s@} (%s) vs vendored @{%s@} (%s)@." + "@{bs-platform version mismatch@} Running bsb @{%s@} \ + (%s) vs vendored @{%s@} (%s)@." Bs_version.version (Filename.dirname (Filename.dirname Sys.executable_name)) - str - stdlib_path - ; - exit 2 - end + str stdlib_path; + exit 2 ) | _ -> assert false -let check_stdlib (map : json_map) cwd (*built_in_package*) = - match Map_string.find_opt map Bsb_build_schemas.use_stdlib with - | Some (False _) -> None - | None - | Some _ -> - begin - let stdlib_path = - Bsb_pkg.resolve_bs_package ~cwd current_package in - let json_spec = - Ext_json_parse.parse_json_from_file - (Filename.concat stdlib_path Literals.package_json) in - match json_spec with - | Obj {map} -> - check_version_exit map stdlib_path; - Some { - Bsb_config_types.package_name = current_package; - package_install_path = stdlib_path // Bsb_config.lib_ocaml; - } - | _ -> assert false - - end -let extract_bs_suffix_exn (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.suffix with - | None -> false - | Some (Str {str} as config ) -> - if str = Literals.suffix_js then false - else if str = Literals.suffix_bs_js then true - else Bsb_exception.config_error config - "expect .bs.js or .js string here" - | Some config -> - Bsb_exception.config_error config - "expect .bs.js or .js string here" - -let extract_gentype_config (map : json_map) cwd - : Bsb_config_types.gentype_config option = - match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with +let check_stdlib (map : json_map) cwd (*built_in_package*) = + match Map_string.find_opt map Bsb_build_schemas.use_stdlib with + | Some (False _) -> None + | None | Some _ -> ( + let stdlib_path = Bsb_pkg.resolve_bs_package ~cwd current_package in + let json_spec = + Ext_json_parse.parse_json_from_file + (Filename.concat stdlib_path Literals.package_json) + in + match json_spec with + | Obj { map } -> + check_version_exit map stdlib_path; + Some + { + Bsb_config_types.package_name = current_package; + package_install_path = stdlib_path // Bsb_config.lib_ocaml; + } + | _ -> assert false ) + + +let extract_gentype_config (map : json_map) cwd : + Bsb_config_types.gentype_config option = + match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with | None -> None - | Some (Obj {map = obj}) -> - Some { path = - match Map_string.find_opt obj Bsb_build_schemas.path with - | None -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" - "gentype/gentype.exe").path - | Some (Str {str}) -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" str).path - | Some config -> - Bsb_exception.config_error config - "path expect to be a string" - } - - | Some config -> - Bsb_exception.config_error - config "gentypeconfig expect an object" - -let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = - match Map_string.find_opt map Bsb_build_schemas.refmt with - | Some (Flo {flo} as config) -> - begin match flo with + | Some (Obj { map = obj }) -> + Some + { + path = + ( match Map_string.find_opt obj Bsb_build_schemas.path with + | None -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + "gentype/gentype.exe") + .path + | Some (Str { str }) -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + str) + .path + | Some config -> + Bsb_exception.config_error config "path expect to be a string" + ); + } + | Some config -> + Bsb_exception.config_error config "gentypeconfig expect an object" + + +let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = + match Map_string.find_opt map Bsb_build_schemas.refmt with + | Some (Flo { flo } as config) -> ( + match flo with | "3" -> None - | _ -> Bsb_exception.config_error config "expect version 3 only" - end - | Some (Str {str}) - -> - Some - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:Bsb_build_schemas.refmt str).path - | Some config -> - Bsb_exception.config_error config "expect version 2 or 3" - | None -> - None - -let extract_string (map : json_map) (field : string) cb = - match Map_string.find_opt map field with - | None -> None - | Some (Str{str}) -> cb str - | Some config -> - Bsb_exception.config_error config (field ^ " expect a string" ) - -let extract_boolean (map : json_map) (field : string) (default : bool) : bool = - match Map_string.find_opt map field with - | None -> default - | Some (True _ ) -> true - | Some (False _) -> false - | Some config -> - Bsb_exception.config_error config (field ^ " expect a boolean" ) - -let extract_reason_react_jsx (map : json_map) = - let default : Bsb_config_types.reason_react_jsx option ref = ref None in + | _ -> Bsb_exception.config_error config "expect version 3 only" ) + | Some (Str { str }) -> + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.refmt str) + .path + | Some config -> Bsb_exception.config_error config "expect version 2 or 3" + | None -> None + + +let extract_string (map : json_map) (field : string) cb = + match Map_string.find_opt map field with + | None -> None + | Some (Str { str }) -> cb str + | Some config -> Bsb_exception.config_error config (field ^ " expect a string") + + +let extract_boolean (map : json_map) (field : string) (default : bool) : bool = + match Map_string.find_opt map field with + | None -> default + | Some (True _) -> true + | Some (False _) -> false + | Some config -> + Bsb_exception.config_error config (field ^ " expect a boolean") + + +let extract_reason_react_jsx (map : json_map) = + let default : Bsb_config_types.reason_react_jsx option ref = ref None in map - |? (Bsb_build_schemas.reason, `Obj begin fun m -> - match Map_string.find_opt m Bsb_build_schemas.react_jsx with - | Some (Flo{loc; flo}) -> - begin match flo with - | "2" -> - default := Some Jsx_v2 - | "3" -> - default := Some Jsx_v3 - | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo - end - | Some x -> Bsb_exception.config_error x - "Unexpected input (expect a version number) for jsx, note boolean is no longer allowed" - | None -> () - end) + |? ( Bsb_build_schemas.reason, + `Obj + (fun m -> + match Map_string.find_opt m Bsb_build_schemas.react_jsx with + | Some (Flo { loc; flo }) -> ( + match flo with + | "2" -> default := Some Jsx_v2 + | "3" -> default := Some Jsx_v3 + | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo + ) + | Some x -> + Bsb_exception.config_error x + "Unexpected input (expect a version number) for jsx, note \ + boolean is no longer allowed" + | None -> ()) ) |> ignore; !default -let extract_warning (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.warnings with - | None -> Bsb_warning.use_default - | Some (Obj {map }) -> Bsb_warning.from_map map + +let extract_warning (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.warnings with + | None -> Bsb_warning.use_default + | Some (Obj { map }) -> Bsb_warning.from_map map | Some config -> Bsb_exception.config_error config "expect an object" -let extract_ignored_dirs (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + +let extract_ignored_dirs (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with | None -> Set_string.empty - | Some (Arr {content}) -> - Set_string.of_list (Bsb_build_util.get_list_string content) - | Some config -> - Bsb_exception.config_error config "expect an array of string" - -let extract_generators (map : json_map) = - let generators = ref Map_string.empty in - (match Map_string.find_opt map Bsb_build_schemas.generators with - | None -> () - | Some (Arr {content = s}) -> - generators := - Ext_array.fold_left s Map_string.empty (fun acc json -> - match json with - | Obj {map = m ; loc} -> - begin match Map_string.find_opt m Bsb_build_schemas.name, - Map_string.find_opt m Bsb_build_schemas.command with - | Some (Str {str = name}), Some ( Str {str = command}) -> - Map_string.add acc name command - | _, _ -> - Bsb_exception.errorf ~loc {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} - end - | _ -> acc ) - | Some config -> - Bsb_exception.config_error config (Bsb_build_schemas.generators ^ " expect an array field") - ); + | Some (Arr { content }) -> + Set_string.of_list (Bsb_build_util.get_list_string content) + | Some config -> Bsb_exception.config_error config "expect an array of string" + + +let extract_generators (map : json_map) = + let generators = ref Map_string.empty in + ( match Map_string.find_opt map Bsb_build_schemas.generators with + | None -> () + | Some (Arr { content = s }) -> + generators := + Ext_array.fold_left s Map_string.empty (fun acc json -> + match json with + | Obj { map = m; loc } -> ( + match + ( Map_string.find_opt m Bsb_build_schemas.name, + Map_string.find_opt m Bsb_build_schemas.command ) + with + | Some (Str { str = name }), Some (Str { str = command }) -> + Map_string.add acc name command + | _, _ -> + Bsb_exception.errorf ~loc + {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} + ) + | _ -> acc) + | Some config -> + Bsb_exception.config_error config + (Bsb_build_schemas.generators ^ " expect an array field") ); !generators - -let extract_dependencies (map : json_map) cwd (field : string ) - : Bsb_config_types.dependencies = - match Map_string.find_opt map field with + +let extract_dependencies (map : json_map) cwd (field : string) : + Bsb_config_types.dependencies = + match Map_string.find_opt map field with | None -> [] - | Some (Arr ({content = s})) -> - Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s)) - | Some config -> - Bsb_exception.config_error config - (field ^ " expect an array") - -(* return an empty array if not found *) -let extract_string_list (map : json_map) (field : string) : string list = - match Map_string.find_opt map field with + | Some (Arr { content = s }) -> + Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> + resolve_package cwd (Bsb_pkg_types.string_as_package s)) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") + + +(* return an empty array if not found *) +let extract_string_list (map : json_map) (field : string) : string list = + match Map_string.find_opt map field with | None -> [] - | Some (Arr {content = s}) -> - Bsb_build_util.get_list_string s - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") - -let extract_ppx - (map : json_map) - (field : string) - ~(cwd : string) : Bsb_config_types.ppx list = - match Map_string.find_opt map field with + | Some (Arr { content = s }) -> Bsb_build_util.get_list_string s + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") + + +let extract_ppx (map : json_map) (field : string) ~(cwd : string) : + Bsb_config_types.ppx list = + match Map_string.find_opt map field with | None -> [] - | Some (Arr {content }) -> - let resolve s = - if s = "" then Bsb_exception.invalid_spec "invalid ppx, empty string found" - else - (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.ppx_flags s).path in - Ext_array.to_list_f content (fun x -> - match x with - | Str x -> - - {Bsb_config_types.name = - resolve x.str; - args = []} - | Arr {content } -> - - let xs = Bsb_build_util.get_list_string content in - (match xs with - | [] -> Bsb_exception.config_error x " empty array is not allowed" - | name :: args -> - {Bsb_config_types.name = resolve name ; args} - ) - | config -> Bsb_exception.config_error config - (field ^ "expect each item to be either string or array") - ) - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") - - - -let extract_js_post_build (map : json_map) cwd : string option = - let js_post_build_cmd = ref None in - map - |? (Bsb_build_schemas.js_post_build, `Obj begin fun m -> - m |? (Bsb_build_schemas.cmd , `Str (fun s -> - js_post_build_cmd := Some (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.js_post_build s).path - - ) - ) - |> ignore - end) - - |> ignore ; + | Some (Arr { content }) -> + let resolve s = + if s = "" then + Bsb_exception.invalid_spec "invalid ppx, empty string found" + else + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.ppx_flags s) + .path + in + Ext_array.to_list_f content (fun x -> + match x with + | Str x -> { Bsb_config_types.name = resolve x.str; args = [] } + | Arr { content } -> ( + let xs = Bsb_build_util.get_list_string content in + match xs with + | [] -> Bsb_exception.config_error x " empty array is not allowed" + | name :: args -> { Bsb_config_types.name = resolve name; args } ) + | config -> + Bsb_exception.config_error config + (field ^ "expect each item to be either string or array")) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") + + +let extract_js_post_build (map : json_map) cwd : string option = + let js_post_build_cmd = ref None in + map + |? ( Bsb_build_schemas.js_post_build, + `Obj + (fun m -> + m + |? ( Bsb_build_schemas.cmd, + `Str + (fun s -> + js_post_build_cmd := + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.js_post_build s) + .path) ) + |> ignore) ) + |> ignore; !js_post_build_cmd -(** ATT: make sure such function is re-entrant. - With a given [cwd] it works anywhere*) -let interpret_json - ~toplevel_package_specs - ~per_proj_dir:(per_proj_dir:string) - - : Bsb_config_types.t = - - (** we should not resolve it too early, - since it is external configuration, no {!Bsb_build_util.convert_and_resolve_path} - *) - - - - - (* When we plan to add more deps here, - Make sure check it is consistent that for nested deps, we have a - quck check by just re-parsing deps - Make sure it works with [-make-world] [-clean-world] - *) - + +(* ATT: make sure such function is re-entrant. With a given [cwd] it works + anywhere *) +let interpret_json ~toplevel_package_specs ~(per_proj_dir : string) : + Bsb_config_types.t = + (* we should not resolve it too early, since it is external configuration, no + {!Bsb_build_util.convert_and_resolve_path} *) + (* When we plan to add more deps here, make sure check it is consistent that + for nested deps, we have a quck check by just re-parsing deps. Make sure it + works with [-make-world] [-clean-world]. *) (* Setting ninja is a bit complex + 1. if [build.ninja] does use [ninja] we need set a variable - 2. we need store it so that we can call ninja correctly - *) - match Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) with - | Obj { map } -> - let package_name, namespace = - extract_package_name_and_namespace map in - let refmt = extract_refmt map per_proj_dir in - let gentype_config = extract_gentype_config map per_proj_dir in - let bs_suffix = extract_bs_suffix_exn map in - (* The default situation is empty *) - let built_in_package = check_stdlib map per_proj_dir in - let package_specs = - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> Bsb_package_specs.default_package_specs - in - let pp_flags : string option = - extract_string map Bsb_build_schemas.pp_flags (fun p -> - if p = "" then - Bsb_exception.invalid_spec "invalid pp, empty string found" - else - Some (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir ~desc:Bsb_build_schemas.pp_flags p).path - ) in - let reason_react_jsx = extract_reason_react_jsx map in - let bs_dependencies = extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies in - let toplevel = toplevel_package_specs = None in - let bs_dev_dependencies = - if toplevel then - extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dev_dependencies - else [] in - begin match Map_string.find_opt map Bsb_build_schemas.sources with - | Some sources -> - let cut_generators = - extract_boolean map Bsb_build_schemas.cut_generators false in - let groups, number_of_dev_groups = Bsb_parse_sources.scan - ~ignored_dirs:(extract_ignored_dirs map) - ~toplevel - ~root: per_proj_dir - ~cut_generators - ~bs_suffix - ~namespace - sources in - { - gentype_config; - bs_suffix ; - package_name ; - namespace ; - warning = extract_warning map; - external_includes = extract_string_list map Bsb_build_schemas.bs_external_includes; - bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags ; - ppx_files = extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; - pp_file = pp_flags ; - bs_dependencies ; - bs_dev_dependencies ; - (* - reference for quoting - {[ - let tmpfile = Filename.temp_file "ocamlpp" "" in - let comm = Printf.sprintf "%s %s > %s" - pp (Filename.quote sourcefile) tmpfile - in - ]} - *) - refmt; - js_post_build_cmd = (extract_js_post_build map per_proj_dir); - package_specs = - (match toplevel_package_specs with - | None -> package_specs - | Some x -> x ); - file_groups = groups; - files_to_install = Hash_set_string.create 96; - built_in_dependency = built_in_package; - generate_merlin = - extract_boolean map Bsb_build_schemas.generate_merlin true; - reason_react_jsx ; - entries = extract_main_entries map; - generators = extract_generators map ; - cut_generators ; - number_of_dev_groups; - } - | None -> - Bsb_exception.invalid_spec - "no sources specified in bsconfig.json" - end - | _ -> - Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" + + 2. we need store it so that we can call ninja correctly *) + match + Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) + with + | Obj { map } -> ( + let package_name, namespace = extract_package_name_and_namespace map in + let refmt = extract_refmt map per_proj_dir in + let gentype_config = extract_gentype_config map per_proj_dir in + (* The default situation is empty *) + let built_in_package = check_stdlib map per_proj_dir in + let package_specs = package_specs_from_obj_map map in + let bs_suffixes = + Bsb_package_specs.extract_in_source_bs_suffixes package_specs + in + let pp_flags : string option = + extract_string map Bsb_build_schemas.pp_flags (fun p -> + if p = "" then + Bsb_exception.invalid_spec "invalid pp, empty string found" + else + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir + ~desc:Bsb_build_schemas.pp_flags p) + .path) + in + let reason_react_jsx = extract_reason_react_jsx map in + let bs_dependencies = + extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies + in + let toplevel = toplevel_package_specs = None in + let bs_dev_dependencies = + if toplevel then + extract_dependencies map per_proj_dir + Bsb_build_schemas.bs_dev_dependencies + else [] + in + match Map_string.find_opt map Bsb_build_schemas.sources with + | Some sources -> + let cut_generators = + extract_boolean map Bsb_build_schemas.cut_generators false + in + let groups, number_of_dev_groups = + Bsb_parse_sources.scan ~ignored_dirs:(extract_ignored_dirs map) + ~toplevel ~root:per_proj_dir ~cut_generators ~bs_suffixes + ~namespace sources + in + { + gentype_config; + package_name; + namespace; + warning = extract_warning map; + external_includes = + extract_string_list map Bsb_build_schemas.bs_external_includes; + bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags; + ppx_files = + extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; + pp_file = pp_flags; + bs_dependencies; + bs_dev_dependencies; + (* reference for quoting {[ let tmpfile = Filename.temp_file + "ocamlpp" "" in let comm = Printf.sprintf "%s %s > %s" pp + (Filename.quote sourcefile) tmpfile in ]} *) + refmt; + js_post_build_cmd = extract_js_post_build map per_proj_dir; + package_specs = + ( match toplevel_package_specs with + | None -> package_specs + | Some x -> x ); + file_groups = groups; + files_to_install = Hash_set_string.create 96; + built_in_dependency = built_in_package; + generate_merlin = + extract_boolean map Bsb_build_schemas.generate_merlin true; + reason_react_jsx; + entries = extract_main_entries map; + generators = extract_generators map; + cut_generators; + number_of_dev_groups; + } + | None -> + Bsb_exception.invalid_spec "no sources specified in bsconfig.json" ) + | _ -> Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" diff --git a/jscomp/bsb/bsb_config_parse.mli b/jscomp/bsb/bsb_config_parse.mli index 244c6b9e2d..8024dec279 100644 --- a/jscomp/bsb/bsb_config_parse.mli +++ b/jscomp/bsb/bsb_config_parse.mli @@ -22,18 +22,9 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val package_specs_from_bsconfig : - unit -> Bsb_package_specs.t - - - - -val interpret_json : - toplevel_package_specs:Bsb_package_specs.t option -> - per_proj_dir:string -> - Bsb_config_types.t - - - - +val package_specs_from_bsconfig : unit -> Bsb_package_specs.t +val interpret_json : + toplevel_package_specs:Bsb_package_specs.t option -> + per_proj_dir:string -> + Bsb_config_types.t diff --git a/jscomp/bsb/bsb_config_types.ml b/jscomp/bsb/bsb_config_types.ml index 8d26d3189a..304c624f62 100644 --- a/jscomp/bsb/bsb_config_types.ml +++ b/jscomp/bsb/bsb_config_types.ml @@ -23,19 +23,19 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type dependency = +type dependency = { - package_name : Bsb_pkg_types.t ; - package_install_path : string ; + package_name : Bsb_pkg_types.t ; + package_install_path : string ; } -type dependencies = dependency list +type dependencies = dependency list (* `string` is a path to the entrypoint *) type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string type compilation_kind_t = Js | Bytecode | Native -type reason_react_jsx = +type reason_react_jsx = | Jsx_v2 | Jsx_v3 (* string option *) @@ -51,35 +51,34 @@ type ppx = { name : string; args : string list } -type t = +type t = { - package_name : string ; + package_name : string ; (* [captial-package] *) - namespace : string option; + namespace : string option; (* CapitalPackage *) - external_includes : string list ; + external_includes : string list ; bsc_flags : string list ; ppx_files : ppx list ; pp_file : string option; bs_dependencies : dependencies; bs_dev_dependencies : dependencies; - built_in_dependency : dependency option; + built_in_dependency : dependency option; warning : Bsb_warning.t; - (*TODO: maybe we should always resolve bs-platform - so that we can calculate correct relative path in + (*TODO: maybe we should always resolve bs-platform + so that we can calculate correct relative path in [.merlin] *) refmt : refmt; js_post_build_cmd : string option; - package_specs : Bsb_package_specs.t ; + package_specs : Bsb_package_specs.t ; file_groups : Bsb_file_groups.t; files_to_install : Hash_set_string.t ; - generate_merlin : bool ; + generate_merlin : bool ; reason_react_jsx : reason_react_jsx option; (* whether apply PPX transform or not*) entries : entries_t list ; - generators : command Map_string.t ; + generators : command Map_string.t ; cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) - bs_suffix : bool ; (* true means [.bs.js] we should pass [-bs-suffix] flag *) gentype_config : gentype_config option; number_of_dev_groups : int } diff --git a/jscomp/bsb/bsb_ninja_file_groups.ml b/jscomp/bsb/bsb_ninja_file_groups.ml index 99726106a9..25522bd090 100644 --- a/jscomp/bsb/bsb_ninja_file_groups.ml +++ b/jscomp/bsb/bsb_ninja_file_groups.ml @@ -22,196 +22,153 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine +let ( // ) = Ext_path.combine - - - - - -let handle_generators oc - (group : Bsb_file_groups.file_group) - custom_rules = - let map_to_source_dir = - (fun x -> Bsb_config.proj_rel (group.dir //x )) in - Ext_list.iter group.generators (fun {output; input; command} -> +let handle_generators oc (group : Bsb_file_groups.file_group) custom_rules = + let map_to_source_dir x = Bsb_config.proj_rel (group.dir // x) in + Ext_list.iter group.generators (fun { output; input; command } -> (*TODO: add a loc for better error message *) - match Map_string.find_opt custom_rules command with - | None -> Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" command - | Some rule -> - Bsb_ninja_targets.output_build oc - ~outputs:(Ext_list.map output map_to_source_dir) - ~inputs:(Ext_list.map input map_to_source_dir) - ~rule - ) - - -let make_common_shadows - package_specs - dirname - dir_index - : Bsb_ninja_targets.shadow list - = - - { key = Bsb_ninja_global_vars.g_pkg_flg; - op = - Append - (Bsb_package_specs.package_flag_of_package_specs - package_specs dirname - ) - } :: - (if Bsb_dir_index.is_lib_dir dir_index then [] else - [ - { key = Bsb_ninja_global_vars.g_dev_incls; - op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); - } - ] - ) - - - -let emit_module_build - (rules : Bsb_ninja_rule.builtin) - (package_specs : Bsb_package_specs.t) - (group_dir_index : Bsb_dir_index.t) - oc - ~bs_suffix - js_post_build_cmd - namespace - (module_info : Bsb_db.module_info) - = - let has_intf_file = module_info.info = Ml_mli in - let is_re = module_info.is_re in - let filename_sans_extension = module_info.name_sans_extension in + match Map_string.find_opt custom_rules command with + | None -> + Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" + command + | Some rule -> + Bsb_ninja_targets.output_build oc + ~outputs:(Ext_list.map output map_to_source_dir) + ~inputs:(Ext_list.map input map_to_source_dir) + ~rule) + + +let make_common_shadows package_specs dirname dir_index : + Bsb_ninja_targets.shadow list = + { + key = Bsb_ninja_global_vars.g_pkg_flg; + op = + Append + (Bsb_package_specs.flags_of_package_specs package_specs dirname); + } + :: + ( if Bsb_dir_index.is_lib_dir dir_index then [] + else + [ + { + key = Bsb_ninja_global_vars.g_dev_incls; + op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); + }; + ] ) + + +let emit_module_build (rules : Bsb_ninja_rule.builtin) + (package_specs : Bsb_package_specs.t) (group_dir_index : Bsb_dir_index.t) oc + js_post_build_cmd namespace (module_info : Bsb_db.module_info) = + let has_intf_file = module_info.info = Ml_mli in + let is_re = module_info.is_re in + let filename_sans_extension = module_info.name_sans_extension in let is_dev = not (Bsb_dir_index.is_lib_dir group_dir_index) in - let input_impl = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) in - let input_intf = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_rei else Literals.suffix_mli) in - let output_mlast = - filename_sans_extension ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast in - let output_mliast = - filename_sans_extension ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast in + let input_impl = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) + in + let input_intf = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_rei else Literals.suffix_mli ) + in + let output_mlast = + filename_sans_extension + ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast + in + let output_mliast = + filename_sans_extension + ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast + in let output_d = filename_sans_extension ^ Literals.suffix_d in - let output_filename_sans_extension = - Ext_namespace.make ?ns:namespace filename_sans_extension - in - let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in - let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in + let output_filename_sans_extension = + Ext_namespace.make ?ns:namespace filename_sans_extension + in + let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in + let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in let output_js = - Bsb_package_specs.get_list_of_output_js package_specs bs_suffix output_filename_sans_extension in - let common_shadows = + Bsb_package_specs.get_list_of_output_js package_specs + output_filename_sans_extension + in + let common_shadows = make_common_shadows package_specs (Filename.dirname output_cmi) - group_dir_index in - let ast_rule = - if is_re then - rules.build_ast_from_re - else - rules.build_ast in - Bsb_ninja_targets.output_build oc - ~outputs:[output_mlast] - ~inputs:[input_impl] - ~rule:ast_rule; - Bsb_ninja_targets.output_build - oc - ~outputs:[output_d] - ~inputs:(if has_intf_file then [output_mlast;output_mliast] else [output_mlast] ) + group_dir_index + in + let ast_rule = if is_re then rules.build_ast_from_re else rules.build_ast in + Bsb_ninja_targets.output_build oc ~outputs:[ output_mlast ] + ~inputs:[ input_impl ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_d ] + ~inputs: + ( if has_intf_file then [ output_mlast; output_mliast ] + else [ output_mlast ] ) ~rule:rules.build_bin_deps - ?shadows:(if is_dev then - Some [{Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group ; - op = - Overwrite (string_of_int (group_dir_index :> int)) }] - else None) - ; - if has_intf_file then begin - Bsb_ninja_targets.output_build oc - ~outputs:[output_mliast] - (* TODO: we can get rid of absloute path if we fixed the location to be - [lib/bs], better for testing? - *) - ~inputs:[input_intf] - ~rule:ast_rule - ; + ?shadows: + ( if is_dev then + Some + [ + { + Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group; + op = Overwrite (string_of_int (group_dir_index :> int)); + }; + ] + else None ); + if has_intf_file then ( Bsb_ninja_targets.output_build oc - ~outputs:[output_cmi] - ~shadows:common_shadows - ~order_only_deps:[output_d] - ~inputs:[output_mliast] - ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) - ; - end; + ~outputs: + [ output_mliast ] + (* TODO: we can get rid of absloute path if we fixed the location to be + [lib/bs], better for testing? *) + ~inputs:[ input_intf ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmi ] + ~shadows:common_shadows ~order_only_deps:[ output_d ] + ~inputs:[ output_mliast ] + ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) ); let shadows = match js_post_build_cmd with | None -> common_shadows | Some cmd -> - {key = Bsb_ninja_global_vars.postbuild; - op = Overwrite ("&& " ^ cmd ^ Ext_string.single_space ^ String.concat Ext_string.single_space output_js)} - :: common_shadows + { + key = Bsb_ninja_global_vars.postbuild; + op = + Overwrite + ( "&& " ^ cmd ^ Ext_string.single_space + ^ String.concat Ext_string.single_space output_js ); + } + :: common_shadows in let rule = - if has_intf_file then - (if is_dev then rules.ml_cmj_js_dev - else rules.ml_cmj_js) - else - (if is_dev then rules.ml_cmj_cmi_js_dev - else rules.ml_cmj_cmi_js - ) + if has_intf_file then + if is_dev then rules.ml_cmj_js_dev else rules.ml_cmj_js + else if is_dev then rules.ml_cmj_cmi_js_dev + else rules.ml_cmj_cmi_js in - Bsb_ninja_targets.output_build oc - ~outputs:[output_cmj] - ~shadows - ~implicit_outputs: - (if has_intf_file then output_js else output_cmi::output_js ) - ~inputs:[output_mlast] - ~implicit_deps:(if has_intf_file then [output_cmi] else [] ) - ~order_only_deps:[output_d] - ~rule - (* ; - {output_cmj; output_cmi} *) - - - - - - -let handle_files_per_dir - oc - ~bs_suffix - ~(rules : Bsb_ninja_rule.builtin) - ~package_specs - ~js_post_build_cmd - ~(files_to_install : Hash_set_string.t) - ~(namespace : string option) - (group: Bsb_file_groups.file_group ) - : unit = - - handle_generators oc group rules.customs ; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmj ] ~shadows + ~implicit_outputs: + (if has_intf_file then output_js else output_cmi :: output_js) + ~inputs:[ output_mlast ] + ~implicit_deps:(if has_intf_file then [ output_cmi ] else []) + ~order_only_deps:[ output_d ] ~rule + + +let handle_files_per_dir oc ~(rules : Bsb_ninja_rule.builtin) ~package_specs + ~js_post_build_cmd ~(files_to_install : Hash_set_string.t) + ~(namespace : string option) (group : Bsb_file_groups.file_group) : unit = + handle_generators oc group rules.customs; let installable = match group.public with | Export_all -> fun _ -> true | Export_none -> fun _ -> false - | Export_set set -> - fun module_name -> - Set_string.mem set module_name in - Map_string.iter group.sources (fun module_name module_info -> - if installable module_name then - Hash_set_string.add files_to_install - module_info.name_sans_extension; - emit_module_build rules - package_specs - group.dir_index - oc - ~bs_suffix - js_post_build_cmd - namespace module_info - ) - - (* ; - Bsb_ninja_targets.phony - oc ~order_only_deps:[] ~inputs:[] ~output:group.dir *) + | Export_set set -> fun module_name -> Set_string.mem set module_name + in + Map_string.iter group.sources (fun module_name module_info -> + if installable module_name then + Hash_set_string.add files_to_install module_info.name_sans_extension; + emit_module_build rules package_specs group.dir_index oc js_post_build_cmd + namespace module_info) - (* pseuduo targets per directory *) +(* pseuduo targets per directory *) diff --git a/jscomp/bsb/bsb_ninja_file_groups.mli b/jscomp/bsb/bsb_ninja_file_groups.mli index 4b70df81fd..fd028582f7 100644 --- a/jscomp/bsb/bsb_ninja_file_groups.mli +++ b/jscomp/bsb/bsb_ninja_file_groups.mli @@ -22,15 +22,12 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - val handle_files_per_dir : out_channel -> - bs_suffix:bool -> rules:Bsb_ninja_rule.builtin -> package_specs:Bsb_package_specs.t -> js_post_build_cmd:string option -> files_to_install:Hash_set_string.t -> - namespace:string option -> - Bsb_file_groups.file_group -> unit + namespace:string option -> + Bsb_file_groups.file_group -> + unit diff --git a/jscomp/bsb/bsb_ninja_gen.ml b/jscomp/bsb/bsb_ninja_gen.ml index 1cf6a3c0b2..b83c568217 100644 --- a/jscomp/bsb/bsb_ninja_gen.ml +++ b/jscomp/bsb/bsb_ninja_gen.ml @@ -22,233 +22,194 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - -(* we need copy package.json into [_build] since it does affect build output - it is a bad idea to copy package.json which requires to copy js files -*) - - +let ( // ) = Ext_path.combine +(* we need copy package.json into [_build] since it does affect build output it + is a bad idea to copy package.json which requires to copy js files *) let dash_i = "-I" +let get_bsc_flags ~(toplevel : bool) (bsc_flags : string list) : string = + String.concat Ext_string.single_space + (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags) + + +let emit_bsc_lib_includes (bs_dependencies : Bsb_config_types.dependencies) + (source_dirs : string list) external_includes (namespace : _ option) + (oc : out_channel) : unit = + (* TODO: bsc_flags contain stdlib path which is in the latter position + currently *) + let all_includes source_dirs = + source_dirs + @ Ext_list.map bs_dependencies (fun x -> x.package_install_path) + @ (* for external includes, if it is absolute path, leave it as is for + relative path './xx', we need '../.././x' since we are in [lib/bs], + [build] is different from merlin though *) + Ext_list.map external_includes (fun x -> + if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) + in + Bsb_ninja_targets.output_kv Bsb_build_schemas.g_lib_incls + (Bsb_build_util.include_dirs + (all_includes + ( if namespace = None then source_dirs + else Filename.current_dir_name :: source_dirs + (*working dir is [lib/bs] we include this path to have namespace + mapping*) ))) + oc -let get_bsc_flags - ~(toplevel : bool) - (bsc_flags : string list) - : string = - String.concat Ext_string.single_space - (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags ) - - -let emit_bsc_lib_includes - (bs_dependencies : Bsb_config_types.dependencies) - (source_dirs : string list) - (external_includes) - (namespace : _ option) - (oc : out_channel): unit = - (* TODO: bsc_flags contain stdlib path which is in the latter position currently *) - let all_includes source_dirs = - source_dirs @ - Ext_list.map bs_dependencies (fun x -> x.package_install_path) @ - ( - (* for external includes, if it is absolute path, leave it as is - for relative path './xx', we need '../.././x' since we are in - [lib/bs], [build] is different from merlin though - *) - Ext_list.map - external_includes - - (fun x -> if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) - ) - in - Bsb_ninja_targets.output_kv - Bsb_build_schemas.g_lib_incls - (Bsb_build_util.include_dirs - (all_includes - (if namespace = None then source_dirs - else Filename.current_dir_name :: source_dirs - (*working dir is [lib/bs] we include this path to have namespace mapping*) - ))) oc - - -let output_static_resources - (static_resources : string list) - copy_rule - oc - = - Ext_list.iter static_resources (fun output -> - Bsb_ninja_targets.output_build - oc - ~outputs:[output] - ~inputs:[Bsb_config.proj_rel output] +let output_static_resources (static_resources : string list) copy_rule oc = + Ext_list.iter static_resources (fun output -> + Bsb_ninja_targets.output_build oc ~outputs:[ output ] + ~inputs:[ Bsb_config.proj_rel output ] ~rule:copy_rule); if static_resources <> [] then - Bsb_ninja_targets.phony - oc - ~order_only_deps:static_resources - ~inputs:[] - ~output:Literals.build_ninja + Bsb_ninja_targets.phony oc ~order_only_deps:static_resources ~inputs:[] + ~output:Literals.build_ninja -let output_ninja_and_namespace_map - ~per_proj_dir - ~toplevel +let output_ninja_and_namespace_map ~per_proj_dir ~toplevel ({ - bs_suffix; - package_name; - external_includes; - bsc_flags ; - pp_file; - ppx_files ; - - bs_dependencies; - bs_dev_dependencies; - refmt; - js_post_build_cmd; - package_specs; - file_groups = { files = bs_file_groups}; - files_to_install; - built_in_dependency; - reason_react_jsx; - generators ; - namespace ; - warning; - gentype_config; - number_of_dev_groups; - } : Bsb_config_types.t) : unit - = - - let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in + package_name; + external_includes; + bsc_flags; + pp_file; + ppx_files; + bs_dependencies; + bs_dev_dependencies; + refmt; + js_post_build_cmd; + package_specs; + file_groups = { files = bs_file_groups }; + files_to_install; + built_in_dependency; + reason_react_jsx; + generators; + namespace; + warning; + gentype_config; + number_of_dev_groups; + } : + Bsb_config_types.t) : unit = + let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in let ppx_flags = Bsb_build_util.ppx_flags ppx_files in - let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in - let g_pkg_flg , g_ns_flg = + let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in + let g_pkg_flg, g_ns_flg = match namespace with - | None -> - Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty - | Some s -> - Ext_string.inter4 - "-bs-package-name" package_name - "-bs-ns" s - , - Ext_string.inter2 "-bs-ns" s in - let () = + | None -> + (Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty) + | Some s -> + ( Ext_string.inter4 "-bs-package-name" package_name "-bs-ns" s, + Ext_string.inter2 "-bs-ns" s ) + in + let () = Ext_option.iter pp_file (fun flag -> Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.pp_flags - (Bsb_build_util.pp_flag flag) oc - ); - Ext_option.iter gentype_config (fun x -> + (Bsb_build_util.pp_flag flag) + oc); + Ext_option.iter gentype_config (fun x -> (* resolved earlier *) Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.gentypeconfig - ("-bs-gentype " ^ x.path) oc - ); - Ext_option.iter built_in_dependency (fun x -> - Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl - (Ext_filename.maybe_quote x.package_install_path) oc - ) - ; - + ("-bs-gentype " ^ x.path) oc); + Ext_option.iter built_in_dependency (fun x -> + Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl + (Ext_filename.maybe_quote x.package_install_path) + oc); Bsb_ninja_targets.output_kvs [| - Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg ; - Bsb_ninja_global_vars.src_root_dir, per_proj_dir (* TODO: need check its integrity -- allow relocate or not? *); - (* The path to [bsc.exe] independent of config *) - Bsb_ninja_global_vars.bsc, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc); + (Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg); + (Bsb_ninja_global_vars.src_root_dir, per_proj_dir) + (* TODO: need check its integrity -- allow relocate or not? *); + (* The path to [bsc.exe] independent of config *) + ( Bsb_ninja_global_vars.bsc, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc ); (* The path to [bsb_heler.exe] *) - Bsb_ninja_global_vars.bsdep, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep) ; - Bsb_ninja_global_vars.warnings, Bsb_warning.to_bsb_string ~toplevel warning ; - Bsb_ninja_global_vars.bsc_flags, (get_bsc_flags ~toplevel bsc_flags) ; - Bsb_ninja_global_vars.ppx_flags, ppx_flags; - - Bsb_ninja_global_vars.g_dpkg_incls, - (Bsb_build_util.include_dirs_by - bs_dev_dependencies - (fun x -> x.package_install_path)); - Bsb_ninja_global_vars.g_ns , g_ns_flg ; - Bsb_build_schemas.bsb_dir_group, "0" (*TODO: avoid name conflict in the future *) - |] oc - in - let bs_groups, bsc_lib_dirs, static_resources = - if number_of_dev_groups = 0 then - let bs_group, source_dirs,static_resources = - Ext_list.fold_left bs_file_groups (Map_string.empty,[],[]) - (fun (acc, dirs,acc_resources) ({sources ; dir; resources } as x) - -> - Bsb_db_util.merge acc sources , - (if Bsb_file_groups.is_empty x then dirs else dir::dirs) , - ( if resources = [] then acc_resources - else Ext_list.map_append resources acc_resources (fun x -> dir // x ) ) - ) in + ( Bsb_ninja_global_vars.bsdep, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep ); + ( Bsb_ninja_global_vars.warnings, + Bsb_warning.to_bsb_string ~toplevel warning ); + (Bsb_ninja_global_vars.bsc_flags, get_bsc_flags ~toplevel bsc_flags); + (Bsb_ninja_global_vars.ppx_flags, ppx_flags); + ( Bsb_ninja_global_vars.g_dpkg_incls, + Bsb_build_util.include_dirs_by bs_dev_dependencies (fun x -> + x.package_install_path) ); + (Bsb_ninja_global_vars.g_ns, g_ns_flg); + (Bsb_build_schemas.bsb_dir_group, "0") + (*TODO: avoid name conflict in the future *); + |] + oc + in + let bs_groups, bsc_lib_dirs, static_resources = + if number_of_dev_groups = 0 then ( + let bs_group, source_dirs, static_resources = + Ext_list.fold_left bs_file_groups (Map_string.empty, [], []) + (fun (acc, dirs, acc_resources) ({ sources; dir; resources } as x) -> + ( Bsb_db_util.merge acc sources, + (if Bsb_file_groups.is_empty x then dirs else dir :: dirs), + if resources = [] then acc_resources + else + Ext_list.map_append resources acc_resources (fun x -> dir // x) + )) + in Bsb_db_util.sanity_check bs_group; - [|bs_group|], source_dirs, static_resources + ([| bs_group |], source_dirs, static_resources) ) else - let bs_groups = Array.init (number_of_dev_groups + 1 ) (fun i -> Map_string.empty) in - let source_dirs = Array.init (number_of_dev_groups + 1 ) (fun i -> []) in + let bs_groups = + Array.init (number_of_dev_groups + 1) (fun i -> Map_string.empty) + in + let source_dirs = Array.init (number_of_dev_groups + 1) (fun i -> []) in let static_resources = - Ext_list.fold_left bs_file_groups [] (fun (acc_resources : string list) {sources; dir; resources; dir_index} - -> - let dir_index = (dir_index :> int) in - bs_groups.(dir_index) <- Bsb_db_util.merge bs_groups.(dir_index) sources ; + Ext_list.fold_left bs_file_groups [] + (fun (acc_resources : string list) + { sources; dir; resources; dir_index } + -> + let dir_index = (dir_index :> int) in + bs_groups.(dir_index) <- + Bsb_db_util.merge bs_groups.(dir_index) sources; source_dirs.(dir_index) <- dir :: source_dirs.(dir_index); - Ext_list.map_append resources acc_resources (fun x -> dir//x) - ) in - let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in + Ext_list.map_append resources acc_resources (fun x -> dir // x)) + in + let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in Bsb_db_util.sanity_check lib; - for i = 1 to number_of_dev_groups do + for i = 1 to number_of_dev_groups do let c = bs_groups.(i) in Bsb_db_util.sanity_check c; - Map_string.iter c - (fun k a -> - if Map_string.mem lib k then - Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k) - ) ; - Bsb_ninja_targets.output_kv - (Bsb_dir_index.(string_of_bsb_dev_include (of_int i))) - (Bsb_build_util.include_dirs source_dirs.(i)) oc - done ; - bs_groups,source_dirs.((Bsb_dir_index.lib_dir_index:>int)), static_resources + Map_string.iter c (fun k a -> + if Map_string.mem lib k then + Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k)); + Bsb_ninja_targets.output_kv + Bsb_dir_index.(string_of_bsb_dev_include (of_int i)) + (Bsb_build_util.include_dirs source_dirs.(i)) + oc + done; + ( bs_groups, + source_dirs.((Bsb_dir_index.lib_dir_index :> int)), + static_resources ) in let digest = Bsb_db_encode.write_build_cache ~dir:cwd_lib_bs bs_groups in - let rules : Bsb_ninja_rule.builtin = - Bsb_ninja_rule.make_custom_rules - ~refmt - ~has_gentype:(gentype_config <> None) + let rules : Bsb_ninja_rule.builtin = + Bsb_ninja_rule.make_custom_rules ~refmt ~has_gentype:(gentype_config <> None) ~has_postbuild:(js_post_build_cmd <> None) - ~has_ppx:(ppx_files <> []) - ~has_pp:(pp_file <> None) + ~has_ppx:(ppx_files <> []) ~has_pp:(pp_file <> None) ~has_builtin:(built_in_dependency <> None) - ~reason_react_jsx - ~bs_suffix - ~digest - generators in - - emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace oc; - output_static_resources static_resources rules.copy_resources oc ; - (** Generate build statement for each file *) - Ext_list.iter bs_file_groups - (fun files_per_dir -> - Bsb_ninja_file_groups.handle_files_per_dir oc - ~bs_suffix - ~rules - ~js_post_build_cmd - ~package_specs - ~files_to_install - ~namespace files_per_dir) - ; + ~reason_react_jsx ~digest generators + in - Ext_option.iter namespace (fun ns -> - let namespace_dir = - per_proj_dir // Bsb_config.lib_bs in - Bsb_namespace_map_gen.output - ~dir:namespace_dir ns - bs_file_groups; - Bsb_ninja_targets.output_build oc - ~outputs:[ns ^ Literals.suffix_cmi] - ~inputs:[ns ^ Literals.suffix_mlmap] - ~rule:rules.build_package - ); + emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace + oc; + output_static_resources static_resources rules.copy_resources oc; + (* Generate build statement for each file *) + Ext_list.iter bs_file_groups (fun files_per_dir -> + Bsb_ninja_file_groups.handle_files_per_dir oc ~rules ~js_post_build_cmd + ~package_specs ~files_to_install ~namespace files_per_dir); + + Ext_option.iter namespace (fun ns -> + let namespace_dir = per_proj_dir // Bsb_config.lib_bs in + Bsb_namespace_map_gen.output ~dir:namespace_dir ns bs_file_groups; + Bsb_ninja_targets.output_build oc + ~outputs:[ ns ^ Literals.suffix_cmi ] + ~inputs:[ ns ^ Literals.suffix_mlmap ] + ~rule:rules.build_package); close_out oc diff --git a/jscomp/bsb/bsb_ninja_gen.mli b/jscomp/bsb/bsb_ninja_gen.mli index 3389261ba1..b2d7a3bb0a 100644 --- a/jscomp/bsb/bsb_ninja_gen.mli +++ b/jscomp/bsb/bsb_ninja_gen.mli @@ -22,10 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - generate ninja file based on [cwd] -*) val output_ninja_and_namespace_map : - per_proj_dir:string -> - toplevel:bool -> - Bsb_config_types.t -> unit + per_proj_dir:string -> toplevel:bool -> Bsb_config_types.t -> unit +(** generate ninja file based on [cwd] *) diff --git a/jscomp/bsb/bsb_ninja_rule.ml b/jscomp/bsb/bsb_ninja_rule.ml index 10bbc0f116..39a33cf1f1 100644 --- a/jscomp/bsb/bsb_ninja_rule.ml +++ b/jscomp/bsb/bsb_ninja_rule.ml @@ -22,237 +22,174 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -type t = { - mutable used : bool; - rule_name : string; - name : out_channel -> string +type t = { + mutable used : bool; + rule_name : string; + name : out_channel -> string; } let get_name (x : t) oc = x.name oc -let print_rule (oc : out_channel) - ~description - ?(restat : unit option) - ?dyndep - ~command - name = - output_string oc "rule "; output_string oc name ; output_string oc "\n"; - output_string oc " command = "; output_string oc command; output_string oc "\n"; +let print_rule (oc : out_channel) ~description ?(restat : unit option) ?dyndep + ~command name = + output_string oc "rule "; + output_string oc name; + output_string oc "\n"; + output_string oc " command = "; + output_string oc command; + output_string oc "\n"; Ext_option.iter dyndep (fun f -> - output_string oc " dyndep = "; output_string oc f; output_string oc "\n" - ); - (if restat <> None then - output_string oc " restat = 1\n"); - - output_string oc " description = " ; output_string oc description; output_string oc "\n" - + output_string oc " dyndep = "; + output_string oc f; + output_string oc "\n"); + if restat <> None then output_string oc " restat = 1\n"; + output_string oc " description = "; + output_string oc description; + output_string oc "\n" (** allocate an unique name for such rule*) -let define - ~command - ?dyndep - ?restat - ?(description = "\027[34mBuilding\027[39m \027[2m${out}\027[22m") (* blue, dim *) - rule_name : t - = - - let rec self = { - used = false; - rule_name ; - name = fun oc -> - if not self.used then - begin - print_rule oc ~description ?dyndep ?restat ~command rule_name; - self.used <- true - end ; - rule_name - } in +let define ~command ?dyndep ?restat + ?(description = + "\027[34mBuilding\027[39m \027[2m${out}\027[22m" (* blue, dim *)) + rule_name : t = + let rec self = + { + used = false; + rule_name; + name = + (fun oc -> + if not self.used then ( + print_rule oc ~description ?dyndep ?restat ~command rule_name; + self.used <- true ); + rule_name); + } + in self - - type command = string type builtin = { build_ast : t; - (** TODO: Implement it on top of pp_flags *) - build_ast_from_re : t ; + (* TODO: Implement it on top of pp_flags *) + build_ast_from_re : t; (* build_ast_from_rei : t ; *) - - - (** platform dependent, on Win32, - invoking cmd.exe - *) copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_bin_deps : t; ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } - -;; - -let make_custom_rules - ~(has_gentype : bool) - ~(has_postbuild : bool) - ~(has_ppx : bool) - ~(has_pp : bool) - ~(has_builtin : bool) - ~(bs_suffix : bool) - ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) - ~(digest : string) - ~(refmt : string option) (* set refmt path when needed *) - (custom_rules : command Map_string.t) : - builtin = - (** FIXME: We don't need set [-o ${out}] when building ast - since the default is already good -- it does not*) - let buf = Buffer.create 100 in - let mk_ml_cmj_cmd - ~read_cmi - ~is_dev - ~postbuild : string = +let make_custom_rules ~(has_gentype : bool) ~(has_postbuild : bool) + ~(has_ppx : bool) ~(has_pp : bool) ~(has_builtin : bool) + ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) + ~(digest : string) ~(refmt : string option) + (* set refmt path when needed *) + (custom_rules : command Map_string.t) : builtin = + (* FIXME: We don't need set [-o ${out}] when building ast since the default is + already good -- it does not *) + let buf = Buffer.create 100 in + let mk_ml_cmj_cmd ~read_cmi ~is_dev ~postbuild : string = Buffer.clear buf; Buffer.add_string buf "$bsc -nostdlib $g_pkg_flg -color always"; - if bs_suffix then - Buffer.add_string buf " -bs-suffix"; - if read_cmi then - Buffer.add_string buf " -bs-read-cmi"; - if is_dev then - Buffer.add_string buf " $g_dev_incls"; - Buffer.add_string buf " $g_lib_incls" ; - if is_dev then - Buffer.add_string buf " $g_dpkg_incls"; - if has_builtin then - Buffer.add_string buf " -I $g_std_incl"; + if read_cmi then Buffer.add_string buf " -bs-read-cmi"; + if is_dev then Buffer.add_string buf " $g_dev_incls"; + Buffer.add_string buf " $g_lib_incls"; + if is_dev then Buffer.add_string buf " $g_dpkg_incls"; + if has_builtin then Buffer.add_string buf " -I $g_std_incl"; Buffer.add_string buf " $warnings $bsc_flags"; - if has_gentype then - Buffer.add_string buf " $gentypeconfig"; + if has_gentype then Buffer.add_string buf " $gentypeconfig"; Buffer.add_string buf " -o $out $in"; - if postbuild then - Buffer.add_string buf " $postbuild"; + if postbuild then Buffer.add_string buf " $postbuild"; Buffer.contents buf - in + in let mk_ast ~(has_pp : bool) ~has_ppx ~has_reason_react_jsx : string = - Buffer.clear buf ; + Buffer.clear buf; Buffer.add_string buf "$bsc $warnings -color always"; - (match refmt with + ( match refmt with | None -> () | Some x -> - Buffer.add_string buf " -bs-refmt "; - Buffer.add_string buf (Ext_filename.maybe_quote x); - ); - if has_pp then - Buffer.add_string buf " $pp_flags"; - (match has_reason_react_jsx, reason_react_jsx with - | false, _ - | _, None -> () - | _, Some Jsx_v2 - -> Buffer.add_string buf " -bs-jsx 2" - | _, Some Jsx_v3 - -> Buffer.add_string buf " -bs-jsx 3" - ); - if has_ppx then - Buffer.add_string buf " $ppx_flags"; - Buffer.add_string buf " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; + Buffer.add_string buf " -bs-refmt "; + Buffer.add_string buf (Ext_filename.maybe_quote x) ); + if has_pp then Buffer.add_string buf " $pp_flags"; + ( match (has_reason_react_jsx, reason_react_jsx) with + | false, _ | _, None -> () + | _, Some Jsx_v2 -> Buffer.add_string buf " -bs-jsx 2" + | _, Some Jsx_v3 -> Buffer.add_string buf " -bs-jsx 3" ); + if has_ppx then Buffer.add_string buf " $ppx_flags"; + Buffer.add_string buf + " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; Buffer.contents buf - in + in let build_ast = define - ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false ) - "build_ast" in + ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false) + "build_ast" + in let build_ast_from_re = define ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:true) - "build_ast_from_re" in - - let copy_resources = - define - ~command:( - if Ext_sys.is_windows_or_cygwin then - "cmd.exe /C copy /Y $in $out > null" - else "cp $in $out" - ) - "copy_resource" in - let build_bin_deps = + "build_ast_from_re" + in + + let copy_resources = define - ~restat:() ~command: - ("$bsdep -hash " ^ digest ^" $g_ns -g $bsb_dir_group $in") - "build_deps" in - let aux ~name ~read_cmi ~postbuild = - let postbuild = has_postbuild && postbuild in - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:false - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - name, - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:true - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - (name ^ "_dev") - in + ( if Ext_sys.is_windows_or_cygwin then + "cmd.exe /C copy /Y $in $out > null" + else "cp $in $out" ) + "copy_resource" + in + let build_bin_deps = + define ~restat:() + ~command:("$bsdep -hash " ^ digest ^ " $g_ns -g $bsb_dir_group $in") + "build_deps" + in + let aux ~name ~read_cmi ~postbuild = + let postbuild = has_postbuild && postbuild in + ( define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:false ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) name, + define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:true ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) + (name ^ "_dev") ) + in (* [g_lib_incls] are fixed for libs *) let ml_cmj_js, ml_cmj_js_dev = - aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true in + aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true + in let ml_cmj_cmi_js, ml_cmj_cmi_js_dev = - aux - ~read_cmi:false - ~name:"ml_cmj_cmi" ~postbuild:true in + aux ~read_cmi:false ~name:"ml_cmj_cmi" ~postbuild:true + in let ml_cmi, ml_cmi_dev = - aux - ~read_cmi:false ~postbuild:false - ~name:"ml_cmi" in - let build_package = - define - ~command:"$bsc -w -49 -color always -no-alias-deps $in" - ~restat:() + aux ~read_cmi:false ~postbuild:false ~name:"ml_cmi" + in + let build_package = + define ~command:"$bsc -w -49 -color always -no-alias-deps $in" ~restat:() "build_package" - in + in { - build_ast ; - build_ast_from_re ; - (** platform dependent, on Win32, - invoking cmd.exe - *) + build_ast; + build_ast_from_re; copy_resources; - (** Rules below all need restat *) - build_bin_deps ; - - ml_cmj_js ; - ml_cmj_js_dev ; - ml_cmj_cmi_js ; - ml_cmi ; - + build_bin_deps; + ml_cmj_js; + ml_cmj_js_dev; + ml_cmj_cmi_js; + ml_cmi; ml_cmj_cmi_js_dev; ml_cmi_dev; - - build_package ; + build_package; customs = - Map_string.mapi custom_rules begin fun name command -> - define ~command ("custom_" ^ name) - end + Map_string.mapi custom_rules (fun name command -> + define ~command ("custom_" ^ name)); } - - diff --git a/jscomp/bsb/bsb_ninja_rule.mli b/jscomp/bsb/bsb_ninja_rule.mli index 928eb927c4..204852365b 100644 --- a/jscomp/bsb/bsb_ninja_rule.mli +++ b/jscomp/bsb/bsb_ninja_rule.mli @@ -22,62 +22,52 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - +type t (** The complexity comes from the fact that we allow custom rules which could - conflict with our custom built-in rules -*) -type t + conflict with our custom built-in rules *) - -val get_name : t -> out_channel -> string +val get_name : t -> out_channel -> string (***********************************************************) -(** A list of existing rules *) + type builtin = { - build_ast : t; - build_ast_from_re : t ; - - (** platform dependent, on Win32, - invoking cmd.exe - *) - copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_ast_from_re : t; + copy_resources : t; (** platform dependent, on Win32, invoking cmd.exe *) + build_bin_deps : t; (** Rules below all need restat *) ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } -(***********************************************************) +(** A list of existing rules *) -(** rules are generally composed of built-in rules and customized rules, there are two design choices: - 1. respect custom rules with the same name, then we need adjust our built-in - rules dynamically in case the conflict. - 2. respect our built-in rules, then we only need re-load custom rules for each bsconfig.json -*) +(***********************************************************) type command = string -(** Since now we generate ninja files per bsconfig.json in a single process, - we must make sure it is re-entrant -*) -val make_custom_rules : + +val make_custom_rules : has_gentype:bool -> has_postbuild:bool -> has_ppx:bool -> has_pp:bool -> - has_builtin:bool -> - bs_suffix:bool -> - reason_react_jsx : Bsb_config_types.reason_react_jsx option -> + has_builtin:bool -> + reason_react_jsx:Bsb_config_types.reason_react_jsx option -> digest:string -> refmt:string option -> command Map_string.t -> builtin +(** rules are generally composed of built-in rules and customized rules, there + are two design choices: + + + respect custom rules with the same name, then we need adjust our built-in + rules dynamically in case the conflict. + + respect our built-in rules, then we only need re-load custom rules for + each bsconfig.json + NOTE: Since now we generate ninja files per bsconfig.json in a single + process, we must make sure it is re-entrant *) diff --git a/jscomp/bsb/bsb_package_specs.ml b/jscomp/bsb/bsb_package_specs.ml index 31ac60ba47..fcb0f8bd75 100644 --- a/jscomp/bsb/bsb_package_specs.ml +++ b/jscomp/bsb/bsb_package_specs.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,161 +17,241 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let ( // ) = Ext_path.combine -let (//) = Ext_path.combine - - - -(* TODO: sync up with {!Js_packages_info.module_system} *) -type format = - | NodeJS | Es6 | Es6_global +(* TODO: sync up with {!Js_package_info.module_system} *) +type format = NodeJS | Es6 | Es6_global -type spec = { - format : format; - in_source : bool -} +type spec = { format : format; in_source : bool; suffix : string } -module Spec_set = Set.Make( struct type t = spec - let compare = Pervasives.compare - end) - -type t = Spec_set.t +module Spec_set = Set.Make (struct + type t = spec + let compare = Pervasives.compare +end) +type t = Spec_set.t let bad_module_format_message_exn ~loc format = - Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s or %s" - format - Literals.commonjs - Literals.es6 - Literals.es6_global + Bsb_exception.errorf ~loc + "package-specs: `%s` isn't a valid output module format. It has to be one \ + of: %s, %s or %s" + format Literals.commonjs Literals.es6 Literals.es6_global + -let supported_format (x : string) loc = +let supported_format (x : string) loc = if x = Literals.commonjs then NodeJS else if x = Literals.es6 then Es6 else if x = Literals.es6_global then Es6_global - else bad_module_format_message_exn ~loc x + else bad_module_format_message_exn ~loc x + let string_of_format (x : format) = - match x with + match x with | NodeJS -> Literals.commonjs | Es6 -> Literals.es6 | Es6_global -> Literals.es6_global -let prefix_of_format (x : format) = - (match x with - | NodeJS -> Bsb_config.lib_js - | Es6 -> Bsb_config.lib_es6 - | Es6_global -> Bsb_config.lib_es6_global ) -let rec from_array (arr : Ext_json_types.t array) : Spec_set.t = - let spec = ref Spec_set.empty in - let has_in_source = ref false in +let prefix_of_format (x : format) = + match x with + | NodeJS -> Bsb_config.lib_js + | Es6 -> Bsb_config.lib_es6 + | Es6_global -> Bsb_config.lib_es6_global + + +let deprecated_bs_suffix_message_warn () = + Bsb_log.warn + "@{DEPRECATED@}: @[top-level 'suffix' field is deprecated;@ \ + please lower your extension-configuration into@ 'package-specs'.@]@." + + +let bad_suffix_message_warn suffix = + let open Literals in + Bsb_log.warn + "@{UNSUPPORTED@}: @[package-specs: extension `%s` is \ + unsupported;@ consider one of: %s, %s, %s; %s, %s,@ or %s.@]@." + suffix suffix_js suffix_mjs suffix_cjs suffix_bs_js suffix_bs_mjs + suffix_bs_cjs + + +let supported_suffix (x : string) = + if + not + (List.mem x + Literals. + [ + suffix_js; + suffix_mjs; + suffix_cjs; + suffix_bs_js; + suffix_bs_mjs; + suffix_bs_cjs; + ]) + then bad_suffix_message_warn x; + x + + +let default_suffix ~deprecated_bs_suffix _format _in_source = + (* match (format, in_source) with *) + (* | NodeJS, false -> Literals.suffix_js *) + (* | NodeJS, true -> Literals.suffix_bs_js *) + (* | _, false -> Literals.suffix_mjs *) + (* | _, true -> Literals.suffix_bs_mjs *) + + (* TODO: In the absence of direction to the contrary, the suffix should + eventually depend on [format] and [in_source]. For now, for + backwards-compatibility, I'm hardcoding. *) + if deprecated_bs_suffix then Literals.suffix_bs_js else Literals.suffix_js + + +module SS = Set.Make (String) + +let supported_bs_suffixes = + Literals.[ suffix_bs_js; suffix_bs_mjs; suffix_bs_cjs ] + + +(** Produces a [list] of supported, bs-prefixed file-suffixes used in + [in-source] package-specs. *) +let extract_in_source_bs_suffixes (package_specs : Spec_set.t) = + let f spec suffixes = + if spec.in_source && List.mem spec.suffix supported_bs_suffixes then + SS.add spec.suffix suffixes + else suffixes + in + let suffixes = Spec_set.fold f package_specs SS.empty in + SS.elements suffixes + + +let rec from_array ~deprecated_bs_suffix (arr : Ext_json_types.t array) : + Spec_set.t = + let specs = ref Spec_set.empty in Ext_array.iter arr (fun x -> - let result = from_json_single x in - if result.in_source then - ( - if not !has_in_source then - has_in_source:= true - else - Bsb_exception.errorf - ~loc:(Ext_json.loc_of x) - "package-specs: we've detected two module formats that are both configured to be in-source." - ); - spec := Spec_set.add result !spec - ); - !spec - -(* TODO: FIXME: better API without mutating *) -and from_json_single (x : Ext_json_types.t) : spec = + let spec = from_json_single ~deprecated_bs_suffix x in + if + Spec_set.exists + (fun o -> + spec.in_source == o.in_source && String.equal spec.suffix o.suffix) + !specs + then + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: two conflicting module formats with the extension \ + `%s` are both configured to be in-source." + spec.suffix + else specs := Spec_set.add spec !specs); + !specs + + +(* FIXME: better API without mutating *) +and from_json_single ~deprecated_bs_suffix (x : Ext_json_types.t) : spec = match x with - | Str {str = format; loc } -> - {format = supported_format format loc ; in_source = false } - | Obj {map; loc} -> - begin match Map_string.find_exn map "module" with - | Str {str = format} -> - let in_source = - match Map_string.find_opt map Bsb_build_schemas.in_source with - | Some (True _) -> true - | Some _ - | None -> false - in - {format = supported_format format loc ; in_source } + | Str { str = format; loc } -> + let format = supported_format format loc in + { + format; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix format false; + } + | Obj { map; loc } -> ( + match Map_string.find_exn map Bsb_build_schemas._module with + | Str { str = format } -> + let format = supported_format format loc in + let in_source = + match Map_string.find_opt map Bsb_build_schemas.in_source with + | Some (True _) -> true + | Some _ | None -> false + in + let suffix = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | Some (Str { str = suffix; loc }) -> supported_suffix suffix + | Some _ -> + Bsb_exception.errorf ~loc + "package-specs: the `suffix` field of the configuration \ + object must be absent, or a string." + | None -> default_suffix ~deprecated_bs_suffix format in_source + in + { format; in_source; suffix } | Arr _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, `module` field should be a string, not an array. If you want to pass multiple module specs, try turning package-specs into an array of objects (or strings) instead." + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, `module` \ + field should be a string, not an array. If you want to pass \ + multiple module specs, try turning package-specs into an array of \ + objects (or strings) instead." | _ -> - Bsb_exception.errorf ~loc - "package-specs: the `module` field of the configuration object should be a string." + Bsb_exception.errorf ~loc + "package-specs: the `module` field of the configuration object \ + should be a string." | exception _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, the `module` field is mandatory." - end - | _ -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x) - "package-specs: we expect either a string or an object." + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, the `module` \ + field is mandatory." ) + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: we expect either a string or an object." + -let from_json (x : Ext_json_types.t) : Spec_set.t = +let from_json ?(deprecated_bs_suffix = false) (x : Ext_json_types.t) : + Spec_set.t = + if deprecated_bs_suffix then deprecated_bs_suffix_message_warn (); match x with - | Arr {content ; _} -> from_array content - | _ -> Spec_set.singleton (from_json_single x ) + | Arr { content; _ } -> from_array ~deprecated_bs_suffix content + | _ -> Spec_set.singleton (from_json_single ~deprecated_bs_suffix x) let bs_package_output = "-bs-package-output" -(** Assume input is valid - {[ -bs-package-output commonjs:lib/js/jscomp/test ]} -*) -let package_flag ({format; in_source } : spec) dir = - Ext_string.inter2 - bs_package_output - (Ext_string.concat3 - (string_of_format format) - Ext_string.single_colon - (if in_source then dir else - prefix_of_format format // dir)) - -let package_flag_of_package_specs (package_specs : t) - (dirname : string ) : string = - Spec_set.fold (fun format acc -> - Ext_string.inter2 acc (package_flag format dirname ) - ) package_specs Ext_string.empty - -let default_package_specs = - Spec_set.singleton - { format = NodeJS ; in_source = false } - - - -(** - [get_list_of_output_js specs "src/hi/hello"] - -*) -let get_list_of_output_js - (package_specs : Spec_set.t) - (bs_suffix : bool) - (output_file_sans_extension : string) - = - Spec_set.fold - (fun (spec : spec) acc -> - let basename = Ext_namespace.change_ext_ns_suffix - output_file_sans_extension - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) - in - (Bsb_config.proj_rel @@ (if spec.in_source then basename - else prefix_of_format spec.format // basename)) - :: acc - ) package_specs [] - - -let list_dirs_by - (package_specs : Spec_set.t) - (f : string -> unit) - = - Spec_set.iter (fun (spec : spec) -> - if not spec.in_source then - f (prefix_of_format spec.format) - ) package_specs \ No newline at end of file +(** Assume input is valid + + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) +let package_flag ({ format; in_source; suffix } : spec) dir = + Ext_string.inter2 bs_package_output + (Ext_string.concat5 (string_of_format format) Ext_string.single_colon + (if in_source then dir else prefix_of_format format // dir) + Ext_string.single_colon suffix) + + +let flags_of_package_specs (package_specs : t) (dirname : string) : string = + Spec_set.fold + (fun format acc -> Ext_string.inter2 acc (package_flag format dirname)) + package_specs Ext_string.empty + + +let default_package_specs ?deprecated_bs_suffix () = + let deprecated_bs_suffix = match deprecated_bs_suffix with + | Some x -> deprecated_bs_suffix_message_warn (); x + | None -> false + in + Spec_set.singleton + { + format = NodeJS; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix NodeJS false; + } + + +(** [get_list_of_output_js specs true "src/hi/hello"] *) +let get_list_of_output_js (package_specs : Spec_set.t) + (output_file_sans_extension : string) = + Spec_set.fold + (fun spec acc -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:output_file_sans_extension ~ext:spec.suffix + in + ( Bsb_config.proj_rel + @@ + if spec.in_source then basename + else prefix_of_format spec.format // basename ) + :: acc) + package_specs [] + + +let list_dirs_by (package_specs : Spec_set.t) (f : string -> unit) = + Spec_set.iter + (fun (spec : spec) -> + if not spec.in_source then f (prefix_of_format spec.format)) + package_specs diff --git a/jscomp/bsb/bsb_package_specs.mli b/jscomp/bsb/bsb_package_specs.mli index e583a14706..1ac3ed6c6f 100644 --- a/jscomp/bsb/bsb_package_specs.mli +++ b/jscomp/bsb/bsb_package_specs.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,29 +17,24 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) type t +val default_package_specs : ?deprecated_bs_suffix:bool -> unit -> t + +val from_json : ?deprecated_bs_suffix:bool -> Ext_json_types.t -> t -val default_package_specs : t +val get_list_of_output_js : t -> string -> string list -val from_json: - Ext_json_types.t -> t +val extract_in_source_bs_suffixes : t -> string list -val get_list_of_output_js : - t -> bool -> string -> string list +val flags_of_package_specs : t -> string -> string +(** Sample output: -(** - Sample output: {[ -bs-package-output commonjs:lib/js/jscomp/test]} -*) -val package_flag_of_package_specs : - t -> string -> string + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) -val list_dirs_by : - t -> - (string -> unit) -> - unit \ No newline at end of file +val list_dirs_by : t -> (string -> unit) -> unit diff --git a/jscomp/bsb/bsb_parse_sources.ml b/jscomp/bsb/bsb_parse_sources.ml index 138ec55e57..78e7483aba 100644 --- a/jscomp/bsb/bsb_parse_sources.ml +++ b/jscomp/bsb/bsb_parse_sources.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,488 +17,497 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type build_generator = Bsb_file_groups.build_generator - - type file_group = Bsb_file_groups.file_group -type t = Bsb_file_groups.t +type t = Bsb_file_groups.t -let is_input_or_output (xs : build_generator list) (x : string) = - Ext_list.exists xs (fun {input; output} -> - let it_is = fun y -> y = x in - Ext_list.exists input it_is || - Ext_list.exists output it_is - ) +let is_input_or_output (xs : build_generator list) (x : string) = + Ext_list.exists xs (fun { input; output } -> + let it_is y = y = x in + Ext_list.exists input it_is || Ext_list.exists output it_is) -let errorf x fmt = - Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt +let errorf x fmt = Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt type cxt = { - toplevel : bool ; - dir_index : Bsb_dir_index.t ; - cwd : string ; + toplevel : bool; + dir_index : Bsb_dir_index.t; + cwd : string; root : string; cut_generators : bool; traverse : bool; namespace : string option; - bs_suffix: bool; - ignored_dirs : Set_string.t + bs_suffixes : string list; + ignored_dirs : Set_string.t; } -(** [public] has a list of modules, we do a sanity check to see if all the listed - modules are indeed valid module components -*) -let collect_pub_modules - (xs : Ext_json_types.t array) - (cache : Bsb_db.t) : Set_string.t = - let set = ref Set_string.empty in - for i = 0 to Array.length xs - 1 do - let v = Array.unsafe_get xs i in - match v with - | Str { str} - -> - if Map_string.mem cache str then - set := Set_string.add !set str - else - Bsb_log.warn - "@{IGNORED@} %S in public is ignored since it is not\ - an existing module@." str - | _ -> - Bsb_exception.errorf - ~loc:(Ext_json.loc_of v) - "public excpect a list of strings" - done ; +(* [public] has a list of modules, we do a sanity check to see if all the listed + modules are indeed valid module components *) +let collect_pub_modules (xs : Ext_json_types.t array) (cache : Bsb_db.t) : + Set_string.t = + let set = ref Set_string.empty in + for i = 0 to Array.length xs - 1 do + let v = Array.unsafe_get xs i in + match v with + | Str { str } -> + if Map_string.mem cache str then set := Set_string.add !set str + else + Bsb_log.warn + "@{IGNORED@} %S in public is ignored since it is notan \ + existing module@." + str + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of v) + "public excpect a list of strings" + done; !set -let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) : Bsb_file_groups.public = - match Map_string.find_opt input Bsb_build_schemas.public with - | Some ((Str({str = s}) as x)) -> - if s = Bsb_build_schemas.export_all then Export_all else - if s = Bsb_build_schemas.export_none then Export_none else - errorf x "invalid str for %s " s - | Some (Arr {content = s}) -> - Export_set (collect_pub_modules s cur_sources) - | Some config -> - Bsb_exception.config_error config "expect array or string" - | None -> - Export_all - -let extract_resources (input : Ext_json_types.t Map_string.t) : string list = - match Map_string.find_opt input Bsb_build_schemas.resources with - | Some (Arr x) -> - Bsb_build_util.get_list_string x.content - | Some config -> - Bsb_exception.config_error config - "expect array " - | None -> [] - - -let extract_input_output (edge : Ext_json_types.t) : string list * string list = - let error () = + +let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) + : Bsb_file_groups.public = + match Map_string.find_opt input Bsb_build_schemas.public with + | Some (Str { str = s } as x) -> + if s = Bsb_build_schemas.export_all then Export_all + else if s = Bsb_build_schemas.export_none then Export_none + else errorf x "invalid str for %s " s + | Some (Arr { content = s }) -> Export_set (collect_pub_modules s cur_sources) + | Some config -> Bsb_exception.config_error config "expect array or string" + | None -> Export_all + + +let extract_resources (input : Ext_json_types.t Map_string.t) : string list = + match Map_string.find_opt input Bsb_build_schemas.resources with + | Some (Arr x) -> Bsb_build_util.get_list_string x.content + | Some config -> Bsb_exception.config_error config "expect array " + | None -> [] + + +let extract_input_output (edge : Ext_json_types.t) : string list * string list = + let error () = errorf edge {| invalid edge format, expect ["output" , ":", "input" ]|} - in - match edge with - | Arr {content} -> - (match Ext_array.find_and_split content - (fun x () -> match x with Str { str =":"} -> true | _ -> false ) - () with - | `No_split -> error () - | `Split ( output, input) -> - (Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str } -> - Some str - | _ -> None) output - , - Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str} -> - Some str (* More rigirous error checking: It would trigger a ninja syntax error *) - | _ -> None) input)) - | _ -> error () + in + match edge with + | Arr { content } -> ( + match + Ext_array.find_and_split content + (fun x () -> + match x with + | Str { str = ":" } -> true + | _ -> false) + () + with + | `No_split -> error () + | `Split (output, input) -> + ( Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> Some str + | _ -> None) + output, + Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> + Some str + (* More rigirous error checking: It would trigger a ninja + syntax error *) + | _ -> None) + input ) ) + | _ -> error () + + type json_map = Ext_json_types.t Map_string.t -let extract_generators (input : json_map) : build_generator list = - match Map_string.find_opt input Bsb_build_schemas.generators with - | Some (Arr { content ; loc_start}) -> - (* Need check is dev build or not *) - Ext_array.fold_left content [] (fun acc x -> - match x with - | Obj { map } -> - (match Map_string.find_opt map Bsb_build_schemas.name , - Map_string.find_opt map Bsb_build_schemas.edge - with - | Some (Str command), Some edge -> - let output, input = extract_input_output edge in - {Bsb_file_groups.input ; output ; command = command.str } :: acc - | _ -> - errorf x "Invalid generator format") - | _ -> errorf x "Invalid generator format" - ) - | Some x -> errorf x "Invalid generator format" +let extract_generators (input : json_map) : build_generator list = + match Map_string.find_opt input Bsb_build_schemas.generators with + | Some (Arr { content; loc_start }) -> + (* Need check is dev build or not *) + Ext_array.fold_left content [] (fun acc x -> + match x with + | Obj { map } -> ( + match + ( Map_string.find_opt map Bsb_build_schemas.name, + Map_string.find_opt map Bsb_build_schemas.edge ) + with + | Some (Str command), Some edge -> + let output, input = extract_input_output edge in + { Bsb_file_groups.input; output; command = command.str } + :: acc + | _ -> errorf x "Invalid generator format" ) + | _ -> errorf x "Invalid generator format") + | Some x -> errorf x "Invalid generator format" | None -> [] -let extract_predicate (m : json_map) : string -> bool = - let excludes = - match Map_string.find_opt m Bsb_build_schemas.excludes with - | None -> [] - | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr - | Some x -> Bsb_exception.config_error x "excludes expect array "in - let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in - match slow_re, excludes with - | Some (Str {str = s}), [] -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 - | Some (Str {str = s}) , _::_ -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 && not (Ext_list.mem_string excludes name) - | Some config, _ -> Bsb_exception.config_error config (Bsb_build_schemas.slow_re ^ " expect a string literal") - | None , _ -> - fun name -> not (Ext_list.mem_string excludes name) + +let extract_predicate (m : json_map) : string -> bool = + let excludes = + match Map_string.find_opt m Bsb_build_schemas.excludes with + | None -> [] + | Some (Arr { content = arr }) -> Bsb_build_util.get_list_string arr + | Some x -> Bsb_exception.config_error x "excludes expect array " + in + let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in + match (slow_re, excludes) with + | Some (Str { str = s }), [] -> + let re = Str.regexp s in + fun name -> Str.string_match re name 0 + | Some (Str { str = s }), _ :: _ -> + let re = Str.regexp s in + fun name -> + Str.string_match re name 0 && not (Ext_list.mem_string excludes name) + | Some config, _ -> + Bsb_exception.config_error config + (Bsb_build_schemas.slow_re ^ " expect a string literal") + | None, _ -> fun name -> not (Ext_list.mem_string excludes name) + (** [parsing_source_dir_map cxt input] - Major work done in this function, - assume [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] - is already checked, so we don't need check it again -*) -let try_unlink s = - try Unix.unlink s - with _ -> - Bsb_log.info "@{Failed to remove %s}@." s - -let bs_cmt_post_process_cmd = + + Major work done in this function, assume + [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] is already + checked, so we don't need check it again *) +let try_unlink s = + try Unix.unlink s with _ -> Bsb_log.info "@{Failed to remove %s}@." s + + +let bs_cmt_post_process_cmd = lazy (try Sys.getenv "BS_CMT_POST_PROCESS_CMD" with _ -> "") -type suffix_kind = - | Cmi of int | Cmt of int | Cmj of int | Cmti of int - | Not_any - -let classify_suffix (x : string) : suffix_kind = - let i = - Ext_string.ends_with_index x Literals.suffix_cmi in - if i >=0 then Cmi i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmj in - if i >= 0 then Cmj i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmt in - if i >= 0 then Cmt i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmti in - if i >= 0 then Cmti i - else Not_any - -(** This is the only place where we do some removal during scanning, - configurabl -*) -let prune_staled_bs_js_files - (context : cxt) - (cur_sources : _ Map_string.t ) - : unit = - let lib_parent = - Filename.concat (Filename.concat context.root Bsb_config.lib_bs) - context.cwd in + +type suffix_kind = + | Cmi of int + | Cmt of int + | Cmj of int + | Cmti of int + | Not_any + +let classify_suffix (x : string) : suffix_kind = + let i = Ext_string.ends_with_index x Literals.suffix_cmi in + if i >= 0 then Cmi i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmj in + if i >= 0 then Cmj i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmt in + if i >= 0 then Cmt i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmti in + if i >= 0 then Cmti i else Not_any + + +(** Attempt to delete any [.bs.[cm]?js] files for a given artifact. *) +let unlink_bs_suffixes context artifact = + List.iter + (fun suffix -> try_unlink (Filename.concat context.cwd (artifact ^ suffix))) + context.bs_suffixes + + +(* This is the only place where we do some removal during scanning, + configurably. *) +let prune_staled_bs_js_files (context : cxt) (cur_sources : _ Map_string.t) : + unit = + let lib_parent = + Filename.concat (Filename.concat context.root Bsb_config.lib_bs) context.cwd + in if Sys.file_exists lib_parent then - let artifacts = Sys.readdir lib_parent in - Ext_array.iter artifacts (fun x -> - let kind = classify_suffix x in - match kind with + let artifacts = Sys.readdir lib_parent in + Ext_array.iter artifacts (fun x -> + let kind = classify_suffix x in + match kind with | Not_any -> () - | Cmi i | Cmt i | Cmj i | Cmti i -> - let j = - if context.namespace = None then i - else - Ext_string.rindex_neg x '-' - in - if j >= 0 then - let cmp = Ext_string.capitalize_sub x j in - if not (Map_string.mem cur_sources cmp) then - begin (* prune action *) - let filepath = Filename.concat lib_parent x in - (match kind with - | Cmt _ -> - let lazy cmd = bs_cmt_post_process_cmd in - - if cmd <> "" then - Ext_pervasives.try_it (fun _ -> - Sys.command ( - cmd ^ - " -cmt-rm " ^ filepath) - ) - | Cmj _ -> - (* remove .bs.js *) - if context.bs_suffix then - try_unlink - (Filename.concat context.cwd - (String.sub x 0 j ^ Literals.suffix_bs_js) - ) - | _ -> ()); - try_unlink filepath - end - else () (* assert false *) - ) - - - - - -(********************************************************************) + | Cmi i | Cmt i | Cmj i | Cmti i -> + let j = + if context.namespace = None then i + else Ext_string.rindex_neg x '-' + in + if j >= 0 then + let cmp = Ext_string.capitalize_sub x j in + if not (Map_string.mem cur_sources cmp) then ( + (* prune action *) + let filepath = Filename.concat lib_parent x in + ( match kind with + | Cmt _ -> + let (lazy cmd) = bs_cmt_post_process_cmd in + + if cmd <> "" then + Ext_pervasives.try_it (fun _ -> + Sys.command (cmd ^ " -cmt-rm " ^ filepath)) + | Cmj _ -> unlink_bs_suffixes context (String.sub x 0 j) + | _ -> () ); + try_unlink filepath ) + else () + (* assert false *)) + + +(* ****************************************************************** *) (* starts parsing *) -let rec - parsing_source_dir_map - ({ cwd = dir;} as cxt ) - (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t - = +let rec parsing_source_dir_map ({ cwd = dir } as cxt) + (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t = if Set_string.mem cxt.ignored_dirs dir then Bsb_file_groups.empty - else - let cur_globbed_dirs = ref false in - let has_generators = not (cxt.cut_generators || not cxt.toplevel) in - let scanned_generators = extract_generators input in - let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in - let base_name_array = - lazy (cur_globbed_dirs := true ; Sys.readdir (Filename.concat cxt.root dir)) in - let output_sources = - Ext_list.fold_left (Ext_list.flat_map scanned_generators (fun x -> x.output)) - Map_string.empty (fun acc o -> - Bsb_db_util.add_basename ~dir acc o) in - let sources = - match Map_string.find_opt input Bsb_build_schemas.files with - | None -> - (** We should avoid temporary files *) - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some (Arr basenames ) -> - Ext_array.fold_left basenames.content output_sources (fun acc basename -> - match basename with - | Str {str = basename;loc} -> - Bsb_db_util.add_basename ~dir acc basename ~error_on_invalid_suffix:loc - | _ -> acc - ) - | Some (Obj {map = map; loc} ) -> (* { excludes : [], slow_re : "" }*) - let predicate = extract_predicate map in - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename || not (predicate basename) then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some x -> Bsb_exception.config_error x "files field expect array or object " - in + else + let cur_globbed_dirs = ref false in + let has_generators = not (cxt.cut_generators || not cxt.toplevel) in + let scanned_generators = extract_generators input in + let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in + let base_name_array = + lazy + ( cur_globbed_dirs := true; + Sys.readdir (Filename.concat cxt.root dir) ) + in + let output_sources = + Ext_list.fold_left + (Ext_list.flat_map scanned_generators (fun x -> x.output)) + Map_string.empty + (fun acc o -> Bsb_db_util.add_basename ~dir acc o) + in + let sources = + match Map_string.find_opt input Bsb_build_schemas.files with + | None -> + (* We should avoid temporary files *) + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if is_input_or_output scanned_generators basename then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some (Arr basenames) -> + Ext_array.fold_left basenames.content output_sources + (fun acc basename -> + match basename with + | Str { str = basename; loc } -> + Bsb_db_util.add_basename ~dir acc basename + ~error_on_invalid_suffix:loc + | _ -> acc) + | Some (Obj { map; loc }) -> + (* { excludes : [], slow_re : "" }*) + let predicate = extract_predicate map in + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if + is_input_or_output scanned_generators basename + || not (predicate basename) + then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some x -> + Bsb_exception.config_error x "files field expect array or object " + in let resources = extract_resources input in - let public = extract_pub input sources in - (** Doing recursive stuff *) - let children = - match sub_dirs_field, - cxt.traverse with - | None , true - | Some (True _), _ -> - let root = cxt.root in - let parent = Filename.concat root dir in - Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty (fun origin x -> - if not (Set_string.mem cxt.ignored_dirs x) && - Sys.is_directory (Filename.concat parent x) then - Bsb_file_groups.merge - ( - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path x); - traverse = true - } Map_string.empty) origin - else origin - ) - (* readdir parent avoiding scanning twice *) - | None, false - | Some (False _), _ -> Bsb_file_groups.empty - | Some s, _ -> parse_sources cxt s - in - (** Do some clean up *) - prune_staled_bs_js_files cxt sources ; - Bsb_file_groups.cons - ~file_group:{ dir ; - sources = sources; - resources ; - public ; - dir_index = cxt.dir_index ; - generators = if has_generators then scanned_generators else [] } - ?globbed_dir:( - if !cur_globbed_dirs then Some dir else None) + let public = extract_pub input sources in + (* Doing recursive stuff *) + let children = + match (sub_dirs_field, cxt.traverse) with + | None, true | Some (True _), _ -> + let root = cxt.root in + let parent = Filename.concat root dir in + Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty + (fun origin x -> + if + (not (Set_string.mem cxt.ignored_dirs x)) + && Sys.is_directory (Filename.concat parent x) + then + Bsb_file_groups.merge + (parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path x); + traverse = true; + } + Map_string.empty) + origin + else origin) + (* readdir parent avoiding scanning twice *) + | None, false | Some (False _), _ -> Bsb_file_groups.empty + | Some s, _ -> parse_sources cxt s + in + (* Do some clean up *) + prune_staled_bs_js_files cxt sources; + Bsb_file_groups.cons + ~file_group: + { + dir; + sources; + resources; + public; + dir_index = cxt.dir_index; + generators = (if has_generators then scanned_generators else []); + } + ?globbed_dir:(if !cur_globbed_dirs then Some dir else None) children -and parsing_single_source ({toplevel; dir_index ; cwd} as cxt ) (x : Ext_json_types.t ) - : t = - match x with - | Str { str = dir } -> - if not toplevel && not (Bsb_dir_index.is_lib_dir dir_index) then - Bsb_file_groups.empty - else - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cwd (Ext_path.simple_convert_node_path_to_os_path dir)} - Map_string.empty - | Obj {map} -> - let current_dir_index = - match Map_string.find_opt map Bsb_build_schemas.type_ with - | Some (Str {str="dev"}) -> - Bsb_dir_index.get_dev_index () - | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} - | None -> dir_index in - if not toplevel && not (Bsb_dir_index.is_lib_dir current_dir_index) then - Bsb_file_groups.empty - else - let dir = - match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - Ext_path.simple_convert_node_path_to_os_path str - | Some x -> Bsb_exception.config_error x "dir expected to be a string" - | None -> - Bsb_exception.config_error x - ( - "required field :" ^ Bsb_build_schemas.dir ^ " missing" ) - +and parsing_single_source ({ toplevel; dir_index; cwd } as cxt) + (x : Ext_json_types.t) : t = + match x with + | Str { str = dir } -> + if (not toplevel) && not (Bsb_dir_index.is_lib_dir dir_index) then + Bsb_file_groups.empty + else + parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cwd + (Ext_path.simple_convert_node_path_to_os_path dir); + } + Map_string.empty + | Obj { map } -> + let current_dir_index = + match Map_string.find_opt map Bsb_build_schemas.type_ with + | Some (Str { str = "dev" }) -> Bsb_dir_index.get_dev_index () + | Some _ -> + Bsb_exception.config_error x {|type field expect "dev" literal |} + | None -> dir_index in - parsing_source_dir_map - {cxt with dir_index = current_dir_index; - cwd= Ext_path.concat cwd dir} map + if (not toplevel) && not (Bsb_dir_index.is_lib_dir current_dir_index) then + Bsb_file_groups.empty + else + let dir = + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + Ext_path.simple_convert_node_path_to_os_path str + | Some x -> Bsb_exception.config_error x "dir expected to be a string" + | None -> + Bsb_exception.config_error x + ("required field :" ^ Bsb_build_schemas.dir ^ " missing") + in + + parsing_source_dir_map + { + cxt with + dir_index = current_dir_index; + cwd = Ext_path.concat cwd dir; + } + map | _ -> Bsb_file_groups.empty -and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = - Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> - Bsb_file_groups.merge (parsing_single_source cxt x) origin - ) -and parse_sources ( cxt : cxt) (sources : Ext_json_types.t ) = - match sources with - | Arr file_groups -> - parsing_arr_sources cxt file_groups.content - | _ -> parsing_single_source cxt sources +and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = + Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> + Bsb_file_groups.merge (parsing_single_source cxt x) origin) + + +and parse_sources (cxt : cxt) (sources : Ext_json_types.t) = + match sources with + | Arr file_groups -> parsing_arr_sources cxt file_groups.content + | _ -> parsing_single_source cxt sources + -let scan - ~toplevel - ~root - ~cut_generators - ~namespace - ~bs_suffix - ~ignored_dirs - x : t * int = +let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffixes ~ignored_dirs x + : t * int = Bsb_dir_index.reset (); - let output = - parse_sources { - ignored_dirs; - toplevel; - dir_index = Bsb_dir_index.lib_dir_index; - cwd = Filename.current_dir_name; - root ; - cut_generators; - namespace; - bs_suffix; - traverse = false - } x in - output, Bsb_dir_index.get_current_number_of_dev_groups () - - - -(* Walk through to do some work *) + let output = + parse_sources + { + ignored_dirs; + toplevel; + dir_index = Bsb_dir_index.lib_dir_index; + cwd = Filename.current_dir_name; + root; + cut_generators; + namespace; + bs_suffixes; + traverse = false; + } + x + in + (output, Bsb_dir_index.get_current_number_of_dev_groups ()) + + +(* Walk through to do some work *) type walk_cxt = { - cwd : string ; - root : string; - traverse : bool; - ignored_dirs : Set_string.t; - } - -let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = - match sources with - | Arr {content} -> - Ext_array.iter content (fun x -> walk_single_source cxt x) - | x -> walk_single_source cxt x -and walk_single_source cxt (x : Ext_json_types.t) = - match x with - | Str {str = dir} - -> - let dir = Ext_path.simple_convert_node_path_to_os_path dir in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir } None - | Obj {map} -> - begin match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - let dir = Ext_path.simple_convert_node_path_to_os_path str in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir} (Map_string.find_opt map Bsb_build_schemas.subdirs) - | _ -> () - end - | _ -> () -and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = - let working_dir = Filename.concat cxt.root cxt.cwd in - if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then begin - let file_array = Sys.readdir working_dir in - (* Remove .re.js when clean up *) - Ext_array.iter file_array begin fun file -> - if Ext_string.ends_with file Literals.suffix_gen_js - || Ext_string.ends_with file Literals.suffix_gen_tsx - then - Sys.remove (Filename.concat working_dir file) - end; - let cxt_traverse = cxt.traverse in - match sub_dirs_field, cxt_traverse with - | None, true - | Some(True _), _ -> - Ext_array.iter file_array begin fun f -> - if not (Set_string.mem cxt.ignored_dirs f) && - Sys.is_directory (Filename.concat working_dir f ) then - walk_source_dir_map - {cxt with - cwd = - Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path f); - traverse = true - } None - end - | None, _ - | Some (False _), _ -> () - | Some s, _ -> walk_sources cxt s - end + cwd : string; + root : string; + traverse : bool; + ignored_dirs : Set_string.t; +} + +let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = + match sources with + | Arr { content } -> + Ext_array.iter content (fun x -> walk_single_source cxt x) + | x -> walk_single_source cxt x + + +and walk_single_source cxt (x : Ext_json_types.t) = + match x with + | Str { str = dir } -> + let dir = Ext_path.simple_convert_node_path_to_os_path dir in + walk_source_dir_map { cxt with cwd = Ext_path.concat cxt.cwd dir } None + | Obj { map } -> ( + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + let dir = Ext_path.simple_convert_node_path_to_os_path str in + walk_source_dir_map + { cxt with cwd = Ext_path.concat cxt.cwd dir } + (Map_string.find_opt map Bsb_build_schemas.subdirs) + | _ -> () ) + | _ -> () + + +and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = + let working_dir = Filename.concat cxt.root cxt.cwd in + if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then ( + let file_array = Sys.readdir working_dir in + (* Remove .re.js when clean up *) + Ext_array.iter file_array (fun file -> + if + Ext_string.ends_with file Literals.suffix_gen_js + || Ext_string.ends_with file Literals.suffix_gen_tsx + then Sys.remove (Filename.concat working_dir file)); + let cxt_traverse = cxt.traverse in + match (sub_dirs_field, cxt_traverse) with + | None, true | Some (True _), _ -> + Ext_array.iter file_array (fun f -> + if + (not (Set_string.mem cxt.ignored_dirs f)) + && Sys.is_directory (Filename.concat working_dir f) + then + walk_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path f); + traverse = true; + } + None) + | None, _ | Some (False _), _ -> () + | Some s, _ -> walk_sources cxt s ) + + (* It makes use of the side effect when [walk_sources], removing suffix_re_js, - TODO: make it configurable - *) -let clean_re_js root = - match Ext_json_parse.parse_json_from_file - (Filename.concat root Literals.bsconfig_json) with - | Obj { map } -> - let ignored_dirs = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with - | Some (Arr {content = x}) -> Set_string.of_list (Bsb_build_util.get_list_string x ) - | Some _ - | None -> Set_string.empty - in - Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) begin fun config -> - Ext_pervasives.try_it (fun () -> - walk_sources { root ; - traverse = true; - cwd = Filename.current_dir_name; - ignored_dirs - } config - ) - end - | _ -> () - | exception _ -> () - \ No newline at end of file + TODO: make it configurable *) +let clean_re_js root = + match + Ext_json_parse.parse_json_from_file + (Filename.concat root Literals.bsconfig_json) + with + | Obj { map } -> + let ignored_dirs = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + | Some (Arr { content = x }) -> + Set_string.of_list (Bsb_build_util.get_list_string x) + | Some _ | None -> Set_string.empty + in + Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) + (fun config -> + Ext_pervasives.try_it (fun () -> + walk_sources + { + root; + traverse = true; + cwd = Filename.current_dir_name; + ignored_dirs; + } + config)) + | _ -> () + | exception _ -> () diff --git a/jscomp/bsb/bsb_parse_sources.mli b/jscomp/bsb/bsb_parse_sources.mli index 2f899f056d..327a436c0e 100644 --- a/jscomp/bsb/bsb_parse_sources.mli +++ b/jscomp/bsb/bsb_parse_sources.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,32 +17,23 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** [scan .. cxt json] - entry is to the [sources] in the schema - given a root, return an object which is - all relative paths, this function will do the IO -*) val scan : - toplevel: bool -> - root: string -> - cut_generators: bool -> - namespace : string option -> - bs_suffix:bool -> + toplevel:bool -> + root:string -> + cut_generators:bool -> + namespace:string option -> + bs_suffixes:string list -> ignored_dirs:Set_string.t -> - Ext_json_types.t -> - Bsb_file_groups.t * int + Ext_json_types.t -> + Bsb_file_groups.t * int +(** [scan .. cxt json] entry is to the [sources] in the schema given a root, + return an object which is all relative paths, this function will do the IO *) -(** This function has some duplication - from [scan], - the parsing assuming the format is - already valid -*) -val clean_re_js: - string -> unit \ No newline at end of file +val clean_re_js : string -> unit +(** This function has some duplication from [scan], the parsing assuming the + format is already valid *) diff --git a/jscomp/build_tests/bucklescript-tea/bsconfig.json b/jscomp/build_tests/bucklescript-tea/bsconfig.json index 76c9041740..8d10a6d44a 100644 --- a/jscomp/build_tests/bucklescript-tea/bsconfig.json +++ b/jscomp/build_tests/bucklescript-tea/bsconfig.json @@ -1,12 +1,11 @@ { "name": "bucklescript-tea", "version": "0.6.11", - "bsc-flags": [ - "-bs-cross-module-opt" - ], + "bsc-flags": ["-bs-cross-module-opt"], "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, "sources": [ "src", @@ -14,6 +13,5 @@ "dir": "test", "type": "dev" } - ], - "suffix": ".bs.js" + ] } diff --git a/jscomp/build_tests/case3/bsconfig.json b/jscomp/build_tests/case3/bsconfig.json index 8e6ae5fbca..73d285e314 100644 --- a/jscomp/build_tests/case3/bsconfig.json +++ b/jscomp/build_tests/case3/bsconfig.json @@ -2,18 +2,17 @@ "name": "case3", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/custom_namespace/bsconfig.json b/jscomp/build_tests/custom_namespace/bsconfig.json index fe59a20d05..1c6384a108 100644 --- a/jscomp/build_tests/custom_namespace/bsconfig.json +++ b/jscomp/build_tests/custom_namespace/bsconfig.json @@ -2,19 +2,19 @@ "name": "namespace", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "namespace": "Foo_bar", - "package-specs":{ + "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "bsc-flags" : ["-bs-no-version-header"], + "bsc-flags": ["-bs-no-version-header"], "bs-dependencies": [], "warnings": { - "number" : "-40+6+7", - "error" : true - }, - "suffix": ".bs.js" + "number": "-40+6+7", + "error": true + } } diff --git a/jscomp/build_tests/customize_namespace/bsconfig.json b/jscomp/build_tests/customize_namespace/bsconfig.json index 9226b7587d..27496286d0 100644 --- a/jscomp/build_tests/customize_namespace/bsconfig.json +++ b/jscomp/build_tests/customize_namespace/bsconfig.json @@ -2,20 +2,17 @@ "name": "a0003", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - "depa", - "depb" - ], + "bs-dependencies": ["depa", "depb"], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/customize_namespace/node_modules/depa/bsconfig.json b/jscomp/build_tests/customize_namespace/node_modules/depa/bsconfig.json index 86b6b3a1e2..98c0494db5 100644 --- a/jscomp/build_tests/customize_namespace/node_modules/depa/bsconfig.json +++ b/jscomp/build_tests/customize_namespace/node_modules/depa/bsconfig.json @@ -2,17 +2,17 @@ "name": "depa", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "namespace" : "depx", + "namespace": "depx", "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/customize_namespace/node_modules/depb/bsconfig.json b/jscomp/build_tests/customize_namespace/node_modules/depb/bsconfig.json index 9ee62b28bf..2b61628096 100644 --- a/jscomp/build_tests/customize_namespace/node_modules/depb/bsconfig.json +++ b/jscomp/build_tests/customize_namespace/node_modules/depb/bsconfig.json @@ -2,17 +2,17 @@ "name": "depb", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "namespace" : true, + "namespace": true, "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/cycle/bsconfig.json b/jscomp/build_tests/cycle/bsconfig.json index be2fb9bf4e..5517bc5d12 100644 --- a/jscomp/build_tests/cycle/bsconfig.json +++ b/jscomp/build_tests/cycle/bsconfig.json @@ -2,18 +2,17 @@ "name": "cycle", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/deprecated_bs_suffix/.gitignore b/jscomp/build_tests/deprecated_bs_suffix/.gitignore new file mode 100644 index 0000000000..fc9778a089 --- /dev/null +++ b/jscomp/build_tests/deprecated_bs_suffix/.gitignore @@ -0,0 +1,26 @@ +*.exe +*.obj +*.out +*.compile +*.native +*.byte +*.cmo +*.annot +*.cmi +*.cmx +*.cmt +*.cmti +*.cma +*.a +*.cmxa +*.obj +*~ +*.annot +*.cmj +*.bak +lib/bs +*.mlast +*.mliast +.vscode +.merlin +**/*.bs.js diff --git a/jscomp/build_tests/deprecated_bs_suffix/bsconfig.json b/jscomp/build_tests/deprecated_bs_suffix/bsconfig.json new file mode 100644 index 0000000000..277875bda2 --- /dev/null +++ b/jscomp/build_tests/deprecated_bs_suffix/bsconfig.json @@ -0,0 +1,11 @@ +{ + "name": "x", + "sources": ".", + "package-specs": [ + { + "module": "commonjs", + "in-source": true + } + ], + "suffix": ".bs.js" +} diff --git a/jscomp/build_tests/deprecated_bs_suffix/demo.ml b/jscomp/build_tests/deprecated_bs_suffix/demo.ml new file mode 100644 index 0000000000..e269467cdc --- /dev/null +++ b/jscomp/build_tests/deprecated_bs_suffix/demo.ml @@ -0,0 +1 @@ +let str = "Hello, world!" diff --git a/jscomp/build_tests/deprecated_bs_suffix/input.js b/jscomp/build_tests/deprecated_bs_suffix/input.js new file mode 100644 index 0000000000..0309c87c0d --- /dev/null +++ b/jscomp/build_tests/deprecated_bs_suffix/input.js @@ -0,0 +1,19 @@ +var child_process = require('child_process') + +var assert = require('assert').strict + +var output = child_process.spawnSync('bsb -clean-world && bsb -make-world', + { + cwd: __dirname, + encoding: 'utf8', + stdio : ['inherit','inherit','pipe'], + shell : true + } +) + +// Should warn the user about the deprecation, +assert.match(output.stderr, /top-level 'suffix' field is deprecated/) + +// ... but still respect it +assert.equal(output.status, 0) +assert.ok(require('./demo.bs')) diff --git a/jscomp/build_tests/devdeps/bsconfig.json b/jscomp/build_tests/devdeps/bsconfig.json index e8828b20c9..f228f4e86e 100644 --- a/jscomp/build_tests/devdeps/bsconfig.json +++ b/jscomp/build_tests/devdeps/bsconfig.json @@ -1,25 +1,25 @@ { "name": "devdeps", "version": "0.1.0", - "sources": [{ - "dir" : "src", - "subdirs" : true - }, + "sources": [ + { + "dir": "src", + "subdirs": true + }, { - "dir" : "test", - "type" : "dev" + "dir": "test", + "type": "dev" } -], + ], "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], + "bs-dependencies": [], "bs-dev-dependencies": ["weird"], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/devonly/bsconfig.json b/jscomp/build_tests/devonly/bsconfig.json index 97ddb400ca..d6f1cca34a 100644 --- a/jscomp/build_tests/devonly/bsconfig.json +++ b/jscomp/build_tests/devonly/bsconfig.json @@ -1,23 +1,25 @@ { "name": "devonly", "version": "0.1.0", - "sources": [{ - "dir" : "src", - "subdirs" : true, - "type": "dev" - },{ - "dir" : "src2", - "type": "dev" - }], + "sources": [ + { + "dir": "src", + "subdirs": true, + "type": "dev" + }, + { + "dir": "src2", + "type": "dev" + } + ], "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/duplicated_symlinked_packages/a/bsconfig.json b/jscomp/build_tests/duplicated_symlinked_packages/a/bsconfig.json index f814332dc1..fcb68294b7 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/a/bsconfig.json +++ b/jscomp/build_tests/duplicated_symlinked_packages/a/bsconfig.json @@ -2,20 +2,17 @@ "name": "a", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - "c", - "z" - ], + "bs-dependencies": ["c", "z"], "warnings": { - "error" : "+101" + "error": "+101" }, "namespace": true, "refmt": 3 diff --git a/jscomp/build_tests/duplicated_symlinked_packages/a/node_modules/z/bsconfig.json b/jscomp/build_tests/duplicated_symlinked_packages/a/node_modules/z/bsconfig.json index c99d72b2b4..f5f176ba7b 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/a/node_modules/z/bsconfig.json +++ b/jscomp/build_tests/duplicated_symlinked_packages/a/node_modules/z/bsconfig.json @@ -2,19 +2,17 @@ "name": "z", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "namespace": true, "refmt": 3 diff --git a/jscomp/build_tests/duplicated_symlinked_packages/b/bsconfig.json b/jscomp/build_tests/duplicated_symlinked_packages/b/bsconfig.json index bd40f3d14e..f25c11a917 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/b/bsconfig.json +++ b/jscomp/build_tests/duplicated_symlinked_packages/b/bsconfig.json @@ -2,19 +2,17 @@ "name": "b", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - "c" - ], + "bs-dependencies": ["c"], "warnings": { - "error" : "+101" + "error": "+101" }, "namespace": true, "refmt": 3 diff --git a/jscomp/build_tests/duplicated_symlinked_packages/c/bsconfig.json b/jscomp/build_tests/duplicated_symlinked_packages/c/bsconfig.json index 2a28e8de06..86a4769fc8 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/c/bsconfig.json +++ b/jscomp/build_tests/duplicated_symlinked_packages/c/bsconfig.json @@ -2,19 +2,17 @@ "name": "c", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "namespace": true, "refmt": 3 diff --git a/jscomp/build_tests/duplicated_symlinked_packages/node_modules/z/bsconfig.json b/jscomp/build_tests/duplicated_symlinked_packages/node_modules/z/bsconfig.json index c99d72b2b4..f5f176ba7b 100644 --- a/jscomp/build_tests/duplicated_symlinked_packages/node_modules/z/bsconfig.json +++ b/jscomp/build_tests/duplicated_symlinked_packages/node_modules/z/bsconfig.json @@ -2,19 +2,17 @@ "name": "z", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "namespace": true, "refmt": 3 diff --git a/jscomp/build_tests/in_source/input.js b/jscomp/build_tests/in_source/input.js index 17cf4f6dce..cf638fc829 100644 --- a/jscomp/build_tests/in_source/input.js +++ b/jscomp/build_tests/in_source/input.js @@ -2,26 +2,19 @@ var child_process = require('child_process') var assert = require('assert') - - - assert.throws( - () => { - var output = child_process.execSync(`bsb -regen`, - { cwd: __dirname, encoding: 'utf8' } - ) + () => { + var output = child_process.execSync(`bsb -regen`, { + cwd: __dirname, + encoding: 'utf8', + }) + }, + function (err) { + if ( + err.message.match(/two conflicting module formats with the extension/) + ) { + return true } - , - function (err){ - if (err.message.match(/detected two module formats/)){ - return true - } - return false - } - + return false + } ) - - -// assert.throws(()=>{ -// throw new Error('Wrong value') -// }, /x/) \ No newline at end of file diff --git a/jscomp/build_tests/install/bsconfig.json b/jscomp/build_tests/install/bsconfig.json index a6647280ad..103083d9c6 100644 --- a/jscomp/build_tests/install/bsconfig.json +++ b/jscomp/build_tests/install/bsconfig.json @@ -1,20 +1,18 @@ { - "name": "install", - "version": "0.1.0", - "sources": { - "dir" : "src", - "subdirs" : true - }, - "package-specs": { - "module": "commonjs", - "in-source": true - }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], - "warnings": { - "error" : "+101" - }, - "refmt": 3 - } - \ No newline at end of file + "name": "install", + "version": "0.1.0", + "sources": { + "dir": "src", + "subdirs": true + }, + "package-specs": { + "module": "commonjs", + "in-source": true, + "suffix": ".bs.js" + }, + "bs-dependencies": [], + "warnings": { + "error": "+101" + }, + "refmt": 3 +} diff --git a/jscomp/build_tests/namespace/bsconfig.json b/jscomp/build_tests/namespace/bsconfig.json index a6185ac73c..47f3d7f26a 100644 --- a/jscomp/build_tests/namespace/bsconfig.json +++ b/jscomp/build_tests/namespace/bsconfig.json @@ -2,22 +2,19 @@ "name": "namespace", "version": "0.1.0", "sources": { - "dir" : "src", - "subdirs" : true + "dir": "src", + "subdirs": true }, "namespace": true, - "package-specs":{ + "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "bsc-flags" : ["-bs-no-version-header"], - "bs-dependencies": [ - "liba", - "libb" - ], + "bsc-flags": ["-bs-no-version-header"], + "bs-dependencies": ["liba", "libb"], "warnings": { - "number" : "-40+6+7", - "error" : true - }, - "suffix": ".bs.js" -} \ No newline at end of file + "number": "-40+6+7", + "error": true + } +} diff --git a/jscomp/build_tests/namespace/node_modules/liba/bsconfig.json b/jscomp/build_tests/namespace/node_modules/liba/bsconfig.json index f88a85e32c..61cd80e5b9 100644 --- a/jscomp/build_tests/namespace/node_modules/liba/bsconfig.json +++ b/jscomp/build_tests/namespace/node_modules/liba/bsconfig.json @@ -2,9 +2,12 @@ "name": "liba", "version": "0.1.0", "sources": "src", - "namespace": true, + "namespace": true, "warnings": { - "error" : true + "error": true }, - "suffix": ".bs.js" -} \ No newline at end of file + "package-specs": { + "module": "commonjs", + "suffix": ".bs.js" + } +} diff --git a/jscomp/build_tests/ocamlgraph/bsconfig.json b/jscomp/build_tests/ocamlgraph/bsconfig.json index b39bdbd291..8438330d3d 100644 --- a/jscomp/build_tests/ocamlgraph/bsconfig.json +++ b/jscomp/build_tests/ocamlgraph/bsconfig.json @@ -1,58 +1,50 @@ { - "name": "graph", - "sources": [ - "libx", + "name": "graph", + "sources": [ + "libx", + { + "dir": "src", + "generators": [ { - "dir": "src", - "generators": [ - { - "name" : "lex", - "edge": [ - "dot_lexer.ml", ":", "dot_lexer.mll" - ] - }, - { - "name" : "lex", - "edge": [ - "gml.ml", ":", "gml.mll" - ] - }, - { - "name" : "yacc", - "edge": [ - "dot_parser.ml", "dot_parser.mli", - ":", "dot_parser.mly" - ] - } - ] + "name": "lex", + "edge": ["dot_lexer.ml", ":", "dot_lexer.mll"] }, { - "dir" : "tests", - "files" : [ - "check.ml" - ,"test_clique.ml" - ,"test_topsort.ml" - ,"test_johnson.ml" - // ,"test_bf.ml" - // relies on Filename.tempfile - ] - } - - ], - "package-specs": { - "module": "commonjs", - "in-source": true - }, - "suffix": ".bs.js", - "generators": [ - { - "name": "lex", - "command": "ocamllex.opt $in" + "name": "lex", + "edge": ["gml.ml", ":", "gml.mll"] }, { - "name": "yacc", - "command": "ocamlyacc $in" + "name": "yacc", + "edge": ["dot_parser.ml", "dot_parser.mli", ":", "dot_parser.mly"] } - ], - "namespace": true -} \ No newline at end of file + ] + }, + { + "dir": "tests", + "files": [ + "check.ml", + "test_clique.ml", + "test_topsort.ml", + "test_johnson.ml" + // ,"test_bf.ml" + // relies on Filename.tempfile + ] + } + ], + "package-specs": { + "module": "commonjs", + "in-source": true, + "suffix": ".bs.js" + }, + "generators": [ + { + "name": "lex", + "command": "ocamllex.opt $in" + }, + { + "name": "yacc", + "command": "ocamlyacc $in" + } + ], + "namespace": true +} diff --git a/jscomp/build_tests/react_ppx/bsconfig.json b/jscomp/build_tests/react_ppx/bsconfig.json index 286c0fc7e9..0c21d706ec 100644 --- a/jscomp/build_tests/react_ppx/bsconfig.json +++ b/jscomp/build_tests/react_ppx/bsconfig.json @@ -1,19 +1,19 @@ { - "name": "react-ppx-tests", - "reason": { - "react-jsx": 3 - }, - "sources": { - "dir": "src", - "subdirs": true - }, - "package-specs": [ - { - "module": "commonjs", - "in-source": true - } - ], - "suffix": ".bs.js", - "namespace": true, - "refmt": 3 -} \ No newline at end of file + "name": "react-ppx-tests", + "reason": { + "react-jsx": 3 + }, + "sources": { + "dir": "src", + "subdirs": true + }, + "package-specs": [ + { + "module": "commonjs", + "in-source": true, + "suffix": ".bs.js" + } + ], + "namespace": true, + "refmt": 3 +} diff --git a/jscomp/build_tests/top/bsconfig.json b/jscomp/build_tests/top/bsconfig.json index 7b2ccdf460..6c748b17de 100644 --- a/jscomp/build_tests/top/bsconfig.json +++ b/jscomp/build_tests/top/bsconfig.json @@ -1,27 +1,27 @@ { "name": "a0002", "version": "0.1.0", - "sources": [{ - "dir" : ".", - "subdirs" : false - }, { - "dir": "re", - "files" : { - "slow-re": "hexll\\.*.ml" - }}, - {"dir":"files", - "files" : ["hello00.ml"] - - }], + "sources": [ + { + "dir": ".", + "subdirs": false + }, + { + "dir": "re", + "files": { + "slow-re": "hexll\\.*.ml" + } + }, + { "dir": "files", "files": ["hello00.ml"] } + ], "package-specs": { "module": "commonjs", - "in-source": true + "in-source": true, + "suffix": ".bs.js" }, - "suffix": ".bs.js", - "bs-dependencies": [ - ], + "bs-dependencies": [], "warnings": { - "error" : "+101" + "error": "+101" }, "refmt": 3 } diff --git a/jscomp/build_tests/zerocycle/bsconfig.json b/jscomp/build_tests/zerocycle/bsconfig.json index a342012732..810e300cb0 100644 --- a/jscomp/build_tests/zerocycle/bsconfig.json +++ b/jscomp/build_tests/zerocycle/bsconfig.json @@ -1,15 +1,10 @@ { "name": "zerocycle", "version": "0.1.0", - "sources": [ - "src" - ], + "sources": ["src"], "package-specs": { "module": "commonjs", - "in-source": true - }, - "suffix": ".bs.js", - "bs-dependencies": [ - // add your bs-dependencies here - ] -} \ No newline at end of file + "in-source": true, + "suffix": ".bs.js" + } +} diff --git a/jscomp/common/bs_warnings.ml b/jscomp/common/bs_warnings.ml index 8a57fbe613..f36dc33754 100644 --- a/jscomp/common/bs_warnings.ml +++ b/jscomp/common/bs_warnings.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,114 +17,103 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x + -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) - - + Format.pp_print_flush warning_formatter () ) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) -(** - Note the standard way of reporting error in compiler: +(** Note the standard way of reporting error in compiler: - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error - Define an error type + Define an error type - type error - exception Error of Location.t * error + type error exception Error of Location.t * error - Provide a printer to error + Provide a printer to error - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) diff --git a/jscomp/common/bs_warnings.mli b/jscomp/common/bs_warnings.mli index ba27d3058b..4a6ae8c0e1 100644 --- a/jscomp/common/bs_warnings.mli +++ b/jscomp/common/bs_warnings.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,21 +17,19 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit diff --git a/jscomp/common/js_config.ml b/jscomp/common/js_config.ml index e547deecb7..1045407e64 100644 --- a/jscomp/common/js_config.ml +++ b/jscomp/common/js_config.ml @@ -22,83 +22,47 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false diff --git a/jscomp/common/js_config.mli b/jscomp/common/js_config.mli index b021048e57..594f4e69c8 100644 --- a/jscomp/common/js_config.mli +++ b/jscomp/common/js_config.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,93 +17,71 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref diff --git a/jscomp/core/js_cmj_format.ml b/jscomp/core/js_cmj_format.ml index ca6902e5e3..d74488c18c 100644 --- a/jscomp/core/js_cmj_format.ml +++ b/jscomp/core/js_cmj_format.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,230 +17,200 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - [@@@ocaml.warning "+9"] - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array (* TODO: add a magic number *) -type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (** Either constant or closed functor *) -} +type cmj_value = { arity : arity; persistent_closed_lambda : Lam.t option } type effect = string option - +(* we don't force people to use package *) let single_na = Single Lam_arity.na -(** we don't force people to use package *) -type cmj_case = Ext_namespace.file_kind - -type keyed_cmj_values - = (string * cmj_value) array + +type keyed_cmj_values = (string * cmj_value) array type t = { - values : keyed_cmj_values ; + values : keyed_cmj_values; pure : bool; - npm_package_path : Js_packages_info.t ; - cmj_case : cmj_case; + package_info : Js_package_info.t; + leading_case : Ext_namespace.leading_case; } + let empty_values = [||] -let mk ~values ~effect ~npm_package_path ~cmj_case : t = + +let mk ~values ~effect ~package_info ~leading_case : t = { - values = Map_string.to_sorted_array values; - pure = effect = None ; - npm_package_path; - cmj_case + values = Map_string.to_sorted_array values; + pure = effect = None; + package_info; + leading_case; } -let cmj_magic_number = "BUCKLE20171012" -let cmj_magic_number_length = - String.length cmj_magic_number - +let cmj_magic_number = "BUCKLE20200410" +let cmj_magic_number_length = String.length cmj_magic_number let digest_length = 16 (*16 chars *) let verify_magic_in_beg ic = - let buffer = really_input_string ic cmj_magic_number_length in + let buffer = really_input_string ic cmj_magic_number_length in if buffer <> cmj_magic_number then - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ (* Serialization .. *) let from_file name : t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let _digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v + let ic = open_in_bin name in + verify_magic_in_beg ic; + let _digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + v + let from_file_with_digest name : t * Digest.t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v,digest - - -let from_string s : t = - let magic_number = String.sub s 0 cmj_magic_number_length in - if magic_number = cmj_magic_number then - Marshal.from_string s (digest_length + cmj_magic_number_length) - else - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + let ic = open_in_bin name in + verify_magic_in_beg ic; + let digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + (v, digest) + + +let from_string s : t = + let magic_number = String.sub s 0 cmj_magic_number_length in + if magic_number = cmj_magic_number then + Marshal.from_string s (digest_length + cmj_magic_number_length) + else + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ + let fixed_length = cmj_magic_number_length + digest_length -let rec for_sure_not_changed (name : string) (header : string) = - if Sys.file_exists name then - let ic = open_in_bin name in - let holder = - really_input_string ic fixed_length in - close_in ic; - holder = header - else false - -(* This may cause some build system always rebuild - maybe should not be turned on by default -*) -let to_file name ~check_exists (v : t) = - let s = Marshal.to_string v [] in - let cur_digest = Digest.string s in - let header = cmj_magic_number ^ cur_digest in - if not (check_exists && for_sure_not_changed name header) then - let oc = open_out_bin name in - output_string oc header; +let rec for_sure_not_changed (name : string) (header : string) = + if Sys.file_exists name then ( + let ic = open_in_bin name in + let holder = really_input_string ic fixed_length in + close_in ic; + holder = header ) + else false + + +(* This may cause some build system always rebuild maybe should not be turned on + by default *) +let to_file name ~check_exists (v : t) = + let s = Marshal.to_string v [] in + let cur_digest = Digest.string s in + let header = cmj_magic_number ^ cur_digest in + if not (check_exists && for_sure_not_changed name header) then ( + let oc = open_out_bin name in + output_string oc header; output_string oc s; - close_out oc - -let keyComp (a : string) (b,_) = - Map_string.compare_key a b - -let not_found = single_na, None -let get_result midVal = - let (_,cmj_value) = midVal in - cmj_value.arity, - if Js_config.get_cross_module_inline () then cmj_value.persistent_closed_lambda - else None - -let rec binarySearchAux arr lo hi (key : string) = - let mid = (lo + hi)/2 in - let midVal = Array.unsafe_get arr mid in - let c = keyComp key midVal in - if c = 0 then - get_result midVal - else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let loVal = (Array.unsafe_get arr lo) in - if fst loVal = key then get_result loVal - else not_found - else binarySearchAux arr lo mid key - else (* a[lo] =< a[mid] < key <= a[hi] *) - if lo = mid then - let hiVal = (Array.unsafe_get arr hi) in - if fst hiVal = key then get_result hiVal - else not_found + close_out oc ) + + +let keyComp (a : string) (b, _) = Map_string.compare_key a b + +let not_found = (single_na, None) +let get_result midVal = + let _, cmj_value = midVal in + ( cmj_value.arity, + if Js_config.get_cross_module_inline () then + cmj_value.persistent_closed_lambda + else None ) + + +let rec binarySearchAux arr lo hi (key : string) = + let mid = (lo + hi) / 2 in + let midVal = Array.unsafe_get arr mid in + let c = keyComp key midVal in + if c = 0 then get_result midVal + else if c < 0 then + (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = Array.unsafe_get arr lo in + if fst loVal = key then get_result loVal else not_found + else binarySearchAux arr lo mid key + else if (* a[lo] =< a[mid] < key <= a[hi] *) + lo = mid then + let hiVal = Array.unsafe_get arr hi in + if fst hiVal = key then get_result hiVal else not_found else binarySearchAux arr mid hi key -let binarySearch (sorted : keyed_cmj_values) (key : string) = - let len = Array.length sorted in + +let binarySearch (sorted : keyed_cmj_values) (key : string) = + let len = Array.length sorted in if len = 0 then not_found - else - let lo = Array.unsafe_get sorted 0 in - let c = keyComp key lo in + else + let lo = Array.unsafe_get sorted 0 in + let c = keyComp key lo in if c < 0 then not_found else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = keyComp key hi in - if c2 > 0 then not_found - else binarySearchAux sorted 0 (len - 1) key + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = keyComp key hi in + if c2 > 0 then not_found else binarySearchAux sorted 0 (len - 1) key -(* FIXME: better error message when ocamldep - get self-cycle -*) -let query_by_name (cmj_table : t ) name = - let values = cmj_table.values in - binarySearch values name +(* FIXME: better error message when ocamldep get self-cycle *) +let query_by_name (cmj_table : t) name = + let values = cmj_table.values in + binarySearch values name -let is_pure (cmj_table : t ) = - cmj_table.pure -let get_npm_package_path (cmj_table : t) = - cmj_table.npm_package_path +let is_pure (cmj_table : t) = cmj_table.pure -let get_cmj_case (cmj_table : t) = - cmj_table.cmj_case +let get_package_info (cmj_table : t) = cmj_table.package_info +let get_leading_case (cmj_table : t) = cmj_table.leading_case (* start dumping *) -let f fmt = Printf.fprintf stdout fmt - -let pp_cmj_case (cmj_case : cmj_case) : unit = - match cmj_case with - | Little_js -> - f "case : little, .js \n" - | Little_bs -> - f "case : little, .bs.js \n" - | Upper_js -> - f "case: upper, .js \n" - | Upper_bs -> - f "case: upper, .bs.js \n" - -let pp_cmj - ({ values ; pure; npm_package_path ; cmj_case} : t) = - f "package info: %s\n" - (Format.asprintf "%a" Js_packages_info.dump_packages_info npm_package_path) - ; - pp_cmj_case cmj_case; - - f "effect: %s\n" - (if pure then "pure" else "not pure"); - Ext_array.iter values - (fun (k , {arity; persistent_closed_lambda}) -> - match arity with - | Single arity -> - f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); - (match persistent_closed_lambda with - | None -> - f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; +let f fmt = Printf.fprintf stdout fmt + +let pp_leading_case (leading_case : Ext_namespace.leading_case) : unit = + match leading_case with + | Upper -> f "case: upper\n" + | Lower -> f "case: lower\n" + + +let pp_cmj ({ values; pure; package_info; leading_case } : t) = + f "package info: %s\n" + (Format.asprintf "%a" Js_package_info.dump_package_info package_info); + pp_leading_case leading_case; + + f "effect: %s\n" (if pure then "pure" else "not pure"); + Ext_array.iter values (fun (k, { arity; persistent_closed_lambda }) -> + match arity with + | Single arity -> ( + f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); + match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s\n" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end ) - | Submodule xs -> - (match persistent_closed_lambda with - | None -> f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; + f "%s: ======[finish]\n" k ) + | Submodule xs -> + ( match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end - ); - Array.iteri - (fun i arity -> f "%s[%i] : %s \n" - k i - (Format.asprintf "%a" Lam_arity.print arity )) - xs - ) \ No newline at end of file + f "%s: ======[finish]\n" k ); + Array.iteri + (fun i arity -> + f "%s[%i] : %s \n" k i + (Format.asprintf "%a" Lam_arity.print arity)) + xs) diff --git a/jscomp/core/js_cmj_format.mli b/jscomp/core/js_cmj_format.mli index 4ad2957e21..67f7615334 100644 --- a/jscomp/core/js_cmj_format.mli +++ b/jscomp/core/js_cmj_format.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,95 +17,61 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** Define intemediate format to be serialized for cross module optimization *) +(** In this module, currently only arity information is exported, + - Short term: constant literals are also exported + - Long term: Benefit? since Google Closure Compiler already did such huge + amount of work + TODO: simple expression, literal small function can be stored, but what + would happen if small function captures other environment, for example + {[ let f x = g x ]} + {[ let f = g ]} *) - - -(** Define intemediate format to be serialized for cross module optimization - *) - -(** In this module, - currently only arity information is exported, - - Short term: constant literals are also exported - - Long term: - Benefit? since Google Closure Compiler already did such huge amount of work - TODO: simple expression, literal small function can be stored, - but what would happen if small function captures other environment - for example - - {[ - let f = fun x -> g x - ]} - - {[ - let f = g - ]} -*) - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (* Either constant or closed functor *) + arity : arity; + persistent_closed_lambda : Lam.t option; + (* Either constant or closed functor *) } type effect = string option -type cmj_case = Ext_namespace.file_kind - -type t +type t - -val mk: - values: cmj_value Map_string.t -> - effect: effect -> - npm_package_path: Js_packages_info.t -> - cmj_case:cmj_case -> +val mk : + values:cmj_value Map_string.t -> + effect:effect -> + package_info:Js_package_info.t -> + leading_case:Ext_namespace.leading_case -> t -val query_by_name : - t -> - string -> - arity * Lam.t option +val query_by_name : t -> string -> arity * Lam.t option -val is_pure : - t -> bool +val is_pure : t -> bool -val get_npm_package_path : - t -> - Js_packages_info.t +val get_package_info : t -> Js_package_info.t -val get_cmj_case : - t -> - cmj_case +val get_leading_case : t -> Ext_namespace.leading_case val single_na : arity - - val from_file : string -> t -val from_file_with_digest : - string -> t * Digest.t +val from_file_with_digest : string -> t * Digest.t val from_string : string -> t -(* Note writing the file if its content is not chnaged -*) -val to_file : - string -> check_exists:bool -> t -> unit +(* Note writing the file if its content is not chnaged *) +val to_file : string -> check_exists:bool -> t -> unit -val pp_cmj: t -> unit \ No newline at end of file +val pp_cmj : t -> unit diff --git a/jscomp/core/js_cmj_load.ml b/jscomp/core/js_cmj_load.ml index 22c7b08801..6c31ae8f25 100644 --- a/jscomp/core/js_cmj_load.ml +++ b/jscomp/core/js_cmj_load.ml @@ -1,5 +1,5 @@ (* Copyright (C) Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,49 +17,39 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* strategy: - If not installed, use the distributed [cmj] files, - make sure that the distributed files are platform independent -*) - +(* strategy: If not installed, use the distributed [cmj] files, make sure that + the distributed files are platform independent *) -type path = string -type cmj_load_info = { - cmj_table : Js_cmj_format.t ; - cmj_path : path ; -} +type path = string +type cmj_load_info = { cmj_table : Js_cmj_format.t; cmj_path : path } -#if BS_COMPILER_IN_BROWSER then -let find_cmj_exn file : cmj_load_info = +#if BS_COMPILER_IN_BROWSER then +let find_cmj_exn file : cmj_load_info = let target = Ext_string.uncapitalize_ascii (Filename.basename file) in match Map_string.find_exn !Js_cmj_datasets.data_sets target with - | v - -> - begin match Lazy.force v with - | exception _ - -> - Ext_log.warn __LOC__ - "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target !Location.input_name ; - Bs_exception.error (Cmj_not_found file) - | v -> {cmj_path = "BROWSER"; cmj_table = v} - (* see {!Js_packages_info.string_of_module_id} *) - end - | exception Not_found - -> - Bs_exception.error (Cmj_not_found file) -#else -let find_cmj_exn file : cmj_load_info = - match Config_util.find_opt file with - | Some f - -> - {cmj_path = f; cmj_table = Js_cmj_format.from_file f} - | None -> - (* ONLY read the stored cmj data in browser environment *) - Bs_exception.error (Cmj_not_found file) + | v -> ( + match Lazy.force v with + | exception _ -> + Ext_log.warn __LOC__ + "@[%s corrupted in database, when looking %s while compiling %s \ + please update @]" + file target !Location.input_name; + Bs_exception.error (Cmj_not_found file) + | v -> + { cmj_path = "BROWSER"; cmj_table = v } + (* see {!Js_package_info.string_of_module_id} *) ) + | exception Not_found -> Bs_exception.error (Cmj_not_found file) -#end \ No newline at end of file +#else +let find_cmj_exn file : cmj_load_info = + match Config_util.find_opt file with + | Some f -> { cmj_path = f; cmj_table = Js_cmj_format.from_file f } + | None -> + (* ONLY read the stored cmj data in browser environment *) + Bs_exception.error (Cmj_not_found file) +#end diff --git a/jscomp/core/js_packages_state.ml b/jscomp/core/js_current_package_info.ml similarity index 66% rename from jscomp/core/js_packages_state.ml rename to jscomp/core/js_current_package_info.ml index b99846f896..8e0fd035b0 100644 --- a/jscomp/core/js_packages_state.ml +++ b/jscomp/core/js_current_package_info.ml @@ -22,27 +22,23 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let packages_info = ref Js_package_info.empty -let packages_info = ref Js_packages_info.empty +let set_package_name name = + if Js_package_info.is_empty !packages_info then + packages_info := Js_package_info.from_name name + else Ext_arg.bad_argf "duplicated flag for -bs-package-name" +let set_package_map module_name = + Clflags.dont_record_crc_unit := Some module_name; + Clflags.open_modules := module_name :: !Clflags.open_modules -let set_package_name name = - if Js_packages_info.is_empty !packages_info then - packages_info := Js_packages_info.from_name name - else - Ext_arg.bad_argf "duplicated flag for -bs-package-name" -let set_package_map module_name = - (* set_package_name name ; - let module_name = Ext_namespace.namespace_of_package_name name in *) - Clflags.dont_record_crc_unit := Some module_name; - Clflags.open_modules := - module_name:: - !Clflags.open_modules - -let update_npm_package_path s = - packages_info := - Js_packages_info.add_npm_package_path !packages_info s +let append_location_descriptor_of_string s = + if Js_package_info.is_empty !packages_info then + Ext_arg.bad_argf "please set package name first using -bs-package-name or -bs-ns" + else + packages_info := Js_package_info.append_location_descriptor_of_string !packages_info s -let get_packages_info () = !packages_info \ No newline at end of file +let get_packages_info () = !packages_info diff --git a/jscomp/core/js_packages_state.mli b/jscomp/core/js_current_package_info.mli similarity index 87% rename from jscomp/core/js_packages_state.mli rename to jscomp/core/js_current_package_info.mli index 38b08d5faa..b26a2f9935 100644 --- a/jscomp/core/js_packages_state.mli +++ b/jscomp/core/js_current_package_info.mli @@ -22,14 +22,10 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val set_package_name : string -> unit +val set_package_map : string -> unit -val set_package_name : string -> unit +val get_packages_info : unit -> Js_package_info.t -val set_package_map : string -> unit - -val get_packages_info : - unit -> Js_packages_info.t - -val update_npm_package_path : - string -> unit \ No newline at end of file +val append_location_descriptor_of_string : string -> unit diff --git a/jscomp/core/js_dump_import_export.mli b/jscomp/core/js_dump_import_export.mli index 255b6ac92f..daa7645b96 100644 --- a/jscomp/core/js_dump_import_export.mli +++ b/jscomp/core/js_dump_import_export.mli @@ -39,4 +39,4 @@ val imports : Ext_pp_scope.t -> Ext_pp.t -> (Ident.t * string) list -> - Ext_pp_scope.t \ No newline at end of file + Ext_pp_scope.t diff --git a/jscomp/core/js_dump_program.ml b/jscomp/core/js_dump_program.ml index 6112fd00ee..11f4fa64a9 100644 --- a/jscomp/core/js_dump_program.ml +++ b/jscomp/core/js_dump_program.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,130 +17,96 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) module P = Ext_pp -module L = Js_dump_lit +module L = Js_dump_lit +let empty_explanation = + "/* This output is empty. Its source's type definitions, externals and/or \ + unused code got optimized away. */\n" +let program_is_empty (x : J.program) = + match x with + | { block = []; exports = []; export_set = _ } -> true + | _ -> false -let empty_explanation = - "/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */\n" -let program_is_empty (x : J.program) = - match x with - | { - block = []; - exports = []; - export_set = _ - } -> true - | _ -> false +let deps_program_is_empty (x : J.deps_program) = + match x with + | { modules = []; program; side_effect = None } -> program_is_empty program + | _ -> false -let deps_program_is_empty (x : J.deps_program) = - match x with - | { modules = []; - program ; - side_effect = None - } -> program_is_empty program - | _ -> false -let program f cxt ( x : J.program ) = +let program f cxt (x : J.program) = P.force_newline f; - let cxt = Js_dump.statement_list true cxt f x.block in + let cxt = Js_dump.statement_list true cxt f x.block in P.force_newline f; Js_dump_import_export.exports cxt f x.exports -let dump_program (x : J.program) oc = - ignore (program (P.from_channel oc) Ext_pp_scope.empty x ) - - -let node_program ~output_dir f ( x : J.deps_program) = - P.string f L.strict_directive; - P.newline f ; - let cxt = - Js_dump_import_export.requires - L.require - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id - x - ~output_dir - NodeJS - )) - in - program f cxt x.program +let dump_program (x : J.program) oc = + ignore (program (P.from_channel oc) Ext_pp_scope.empty x) +let node_program ~output_dir ~ext f (x : J.deps_program) = + P.string f L.strict_directive; + P.newline f; + let cxt = + Js_dump_import_export.requires L.require Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext NodeJS + ))) + in + program f cxt x.program -let es6_program ~output_dir fmt f ( x : J.deps_program) = - let cxt = - Js_dump_import_export.imports - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id x ~output_dir - fmt - )) + +let es6_program ~output_dir ~ext fmt f (x : J.deps_program) = + let cxt = + Js_dump_import_export.imports Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext fmt ))) in - let () = P.force_newline f in - let cxt = Js_dump.statement_list true cxt f x.program.block in - let () = P.force_newline f in + let () = P.force_newline f in + let cxt = Js_dump.statement_list true cxt f x.program.block in + let () = P.force_newline f in Js_dump_import_export.es6_export cxt f x.program.exports - (** Make sure github linguist happy + {[ require('Linguist') Linguist::FileBlob.new('jscomp/test/test_u.js').generated? - ]} -*) - -let pp_deps_program - ~output_prefix - (kind : Js_packages_info.module_system ) - (program : J.deps_program) (f : Ext_pp.t) = - if not !Js_config.no_version_header then - begin - P.string f Bs_version.header; - P.newline f - end ; - if deps_program_is_empty program then - P.string f empty_explanation + ]} *) + +let pp_deps_program ~output_prefix ~ext (kind : Js_package_info.module_system) + (program : J.deps_program) (f : Ext_pp.t) = + if not !Js_config.no_version_header then ( + P.string f Bs_version.header; + P.newline f ); + if deps_program_is_empty program then P.string f empty_explanation (* This is empty module, it won't be referred anywhere *) - else - let output_dir = Filename.dirname output_prefix in - begin - ignore (match kind with - | Es6 | Es6_global -> - es6_program ~output_dir kind f program - | NodeJS -> - node_program ~output_dir f program - ) ; - P.newline f ; - P.string f ( - match program.side_effect with - | None -> "/* No side effect */" - | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); - P.newline f; - P.flush f () - end - - - -let dump_deps_program - ~output_prefix - kind - x - (oc : out_channel) = - pp_deps_program ~output_prefix kind x (P.from_channel oc) + else + let output_dir = Filename.dirname output_prefix in + ignore + ( match kind with + | Es6 | Es6_global -> es6_program ~output_dir ~ext kind f program + | NodeJS -> node_program ~output_dir ~ext f program ); + P.newline f; + P.string f + ( match program.side_effect with + | None -> "/* No side effect */" + | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); + P.newline f; + P.flush f () + + +let dump_deps_program ~output_prefix ~ext kind x (oc : out_channel) = + pp_deps_program ~output_prefix ~ext kind x (P.from_channel oc) diff --git a/jscomp/core/js_dump_program.mli b/jscomp/core/js_dump_program.mli index 48f713639d..ca1ac1fa06 100644 --- a/jscomp/core/js_dump_program.mli +++ b/jscomp/core/js_dump_program.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,28 +17,26 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** only used for debugging purpose *) val dump_program : J.program -> out_channel -> unit - +(** only used for debugging purpose *) val pp_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - Ext_pp.t -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + Ext_pp.t -> unit - val dump_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - out_channel -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + out_channel -> unit - \ No newline at end of file diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 2a28b340be..41fb02f585 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -10,94 +10,75 @@ (* *) (***********************************************************************) -(* adapted by bucklescript from [driver/compile.ml] for convenience *) +(* adapted by bucklescript from [driver/compile.ml] for convenience *) open Format open Typedtree open Compenv - - let fprintf = Format.fprintf - - let print_if_pipe ppf flag printer arg = if !flag then fprintf ppf "%a@." printer arg; arg -let print_if ppf flag printer arg = - if !flag then fprintf ppf "%a@." printer arg - +let print_if ppf flag printer arg = if !flag then fprintf ppf "%a@." printer arg -let process_with_gentype filename = +let process_with_gentype filename = match !Clflags.bs_gentype with | None -> () - | Some cmd -> - let comm = (cmd ^ - " -bs-version " ^ Bs_version.version ^ - " -cmt-add " ^ - filename ^ - ( ":" ^ !Location.input_name)) in - if !Clflags.verbose then begin - prerr_string "+ "; - prerr_endline comm; - prerr_newline () - end ; - ignore - (Sys.command comm - ) - -let after_parsing_sig ppf outputprefix ast = - if !Js_config.simple_binary_ast then begin - let oc = open_out_bin (outputprefix ^ Literals.suffix_mliast_simple) in + | Some cmd -> + let comm = + cmd ^ " -bs-version " ^ Bs_version.version ^ " -cmt-add " ^ filename + ^ ":" ^ !Location.input_name + in + if !Clflags.verbose then ( + prerr_string "+ "; + prerr_endline comm; + prerr_newline () ); + ignore (Sys.command comm) + + +let after_parsing_sig ppf outputprefix ast = + if !Js_config.simple_binary_ast then ( + let oc = open_out_bin (outputprefix ^ Literals.suffix_mliast_simple) in Ml_binary.write_ast Mli !Location.input_name ast oc; - close_out oc ; - end; + close_out oc ); if !Js_config.binary_ast then - begin - Binary_ast.write_ast - Mli - ~sourcefile:!Location.input_name - ~output:(outputprefix ^ if !Js_config.is_reason then Literals.suffix_reiast else Literals.suffix_mliast) - (* to support relocate to another directory *) - ast - - end; - if !Js_config.syntax_only then - Warnings.check_fatal() - else - begin - let modulename = module_of_filename ppf !Location.input_name outputprefix in - Lam_compile_env.reset () ; - let initial_env = Compmisc.initial_env () in - Env.set_unit_name modulename; - - let tsg = Typemod.type_interface - !Location.input_name - initial_env ast in - if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; - let sg = tsg.sig_type in - if !Clflags.print_types then - Printtyp.wrap_printing_env initial_env (fun () -> - fprintf std_formatter "%a@." - Printtyp.signature (Typemod.simplify_signature sg)); - ignore (Includemod.signatures initial_env sg sg); - Typecore.force_delayed_checks (); - Warnings.check_fatal (); - if not !Clflags.print_types then begin - - let deprecated = Builtin_attributes.deprecated_of_sig ast in - let sg = - Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi") - in - Typemod.save_signature modulename tsg outputprefix !Location.input_name - initial_env sg ; - process_with_gentype (outputprefix ^ ".cmti"); - end - end - + Binary_ast.write_ast Mli ~sourcefile:!Location.input_name + ~output: + ( outputprefix + ^ + if !Js_config.is_reason then Literals.suffix_reiast + else Literals.suffix_mliast ) + (* to support relocate to another directory *) + ast; + if !Js_config.syntax_only then Warnings.check_fatal () + else + let modulename = module_of_filename ppf !Location.input_name outputprefix in + Lam_compile_env.reset (); + let initial_env = Compmisc.initial_env () in + Env.set_unit_name modulename; + + let tsg = Typemod.type_interface !Location.input_name initial_env ast in + if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; + let sg = tsg.sig_type in + if !Clflags.print_types then + Printtyp.wrap_printing_env initial_env (fun () -> + fprintf std_formatter "%a@." Printtyp.signature + (Typemod.simplify_signature sg)); + ignore (Includemod.signatures initial_env sg sg); + Typecore.force_delayed_checks (); + Warnings.check_fatal (); + if not !Clflags.print_types then ( + let deprecated = Builtin_attributes.deprecated_of_sig ast in + let sg = + Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi") + in + Typemod.save_signature modulename tsg outputprefix !Location.input_name + initial_env sg; + process_with_gentype (outputprefix ^ ".cmti") ) let interface ppf fname outputprefix = @@ -105,133 +86,122 @@ let interface ppf fname outputprefix = Pparse.parse_interface ~tool_name:Js_config.tool_name ppf fname |> Ppx_entry.rewrite_signature |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface - |> print_if_pipe ppf Clflags.dump_source Pprintast.signature - |> after_parsing_sig ppf outputprefix + |> print_if_pipe ppf Clflags.dump_source Pprintast.signature + |> after_parsing_sig ppf outputprefix + -let interface_mliast ppf fname outputprefix = +let interface_mliast ppf fname outputprefix = Compmisc.init_path false; - Binary_ast.read_ast Mli fname + Binary_ast.read_ast Mli fname |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface - |> print_if_pipe ppf Clflags.dump_source Pprintast.signature - |> after_parsing_sig ppf outputprefix - -let all_module_alias (ast : Parsetree.structure)= - Ext_list.for_all ast (fun {pstr_desc} -> - match pstr_desc with - | Pstr_module {pmb_expr = {pmod_desc = Pmod_ident _ }} - -> true - | Pstr_attribute _ -> true - | Pstr_eval _ - | Pstr_value _ - | Pstr_primitive _ - | Pstr_type _ - | Pstr_typext _ - | Pstr_exception _ - | Pstr_module _ - | Pstr_recmodule _ - | Pstr_modtype _ - | Pstr_open _ - | Pstr_class _ - | Pstr_class_type _ - | Pstr_include _ - | Pstr_extension _ -> false - ) - -let after_parsing_impl ppf outputprefix ast = - Js_config.all_module_aliases := - !Clflags.assume_no_mli = Mli_non_exists && - all_module_alias ast - ; - if !Js_config.simple_binary_ast then begin - let oc = open_out_bin (outputprefix ^ Literals.suffix_mlast_simple) in - Ml_binary.write_ast Ml !Location.input_name ast oc; - close_out oc ; - end; + |> print_if_pipe ppf Clflags.dump_source Pprintast.signature + |> after_parsing_sig ppf outputprefix + + +let all_module_alias (ast : Parsetree.structure) = + Ext_list.for_all ast (fun { pstr_desc } -> + match pstr_desc with + | Pstr_module { pmb_expr = { pmod_desc = Pmod_ident _ } } -> true + | Pstr_attribute _ -> true + | Pstr_eval _ + | Pstr_value _ + | Pstr_primitive _ + | Pstr_type _ + | Pstr_typext _ + | Pstr_exception _ + | Pstr_module _ + | Pstr_recmodule _ + | Pstr_modtype _ + | Pstr_open _ + | Pstr_class _ + | Pstr_class_type _ + | Pstr_include _ + | Pstr_extension _ -> false) + + +let after_parsing_impl ppf outputprefix ast = + Js_config.all_module_aliases := + !Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast; + if !Js_config.simple_binary_ast then ( + let oc = open_out_bin (outputprefix ^ Literals.suffix_mlast_simple) in + Ml_binary.write_ast Ml !Location.input_name ast oc; + close_out oc ); if !Js_config.binary_ast then - Binary_ast.write_ast ~sourcefile:!Location.input_name - Ml ~output:(outputprefix ^ - if !Js_config.is_reason then Literals.suffix_reast else Literals.suffix_mlast - ) - ast ; - if !Js_config.syntax_only then - Warnings.check_fatal () - else - begin - let modulename = Ext_filename.module_name outputprefix in - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in - Env.set_unit_name modulename; - let (typedtree, coercion, _, _) = - Typemod.type_implementation_more - ?check_exists:(if !Js_config.force_cmi then None else Some ()) - !Location.input_name outputprefix modulename env ast in - let typedtree_coercion = (typedtree, coercion) in - print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion typedtree_coercion ; - if !Clflags.print_types || !Js_config.cmi_only then begin - Warnings.check_fatal (); - end else begin - let lambda = Translmod.transl_implementation modulename typedtree_coercion in - let js_program = - print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda.code - |> Lam_compile_main.compile outputprefix in - if not !Js_config.cmj_only then - Lam_compile_main.lambda_as_module - js_program - outputprefix - ; - end; - process_with_gentype (outputprefix ^ ".cmt") - end + Binary_ast.write_ast ~sourcefile:!Location.input_name Ml + ~output: + ( outputprefix + ^ + if !Js_config.is_reason then Literals.suffix_reast + else Literals.suffix_mlast ) + ast; + if !Js_config.syntax_only then Warnings.check_fatal () + else + let modulename = Ext_filename.module_name outputprefix in + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + Env.set_unit_name modulename; + let typedtree, coercion, _, _ = + Typemod.type_implementation_more + ?check_exists:(if !Js_config.force_cmi then None else Some ()) + !Location.input_name outputprefix modulename env ast + in + let typedtree_coercion = (typedtree, coercion) in + print_if ppf Clflags.dump_typedtree Printtyped.implementation_with_coercion + typedtree_coercion; + ( if !Clflags.print_types || !Js_config.cmi_only then Warnings.check_fatal () + else + let lambda = + Translmod.transl_implementation modulename typedtree_coercion + in + let js_program = + print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda.code + |> Lam_compile_main.compile outputprefix + in + if not !Js_config.cmj_only then + Lam_compile_main.lambda_as_module js_program outputprefix ); + process_with_gentype (outputprefix ^ ".cmt") + + let implementation ppf fname outputprefix = Compmisc.init_path false; Pparse.parse_implementation ~tool_name:Js_config.tool_name ppf fname |> Ppx_entry.rewrite_implementation |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix + |> after_parsing_impl ppf outputprefix -let implementation_mlast ppf fname outputprefix = + +let implementation_mlast ppf fname outputprefix = Compmisc.init_path false; Binary_ast.read_ast Ml fname |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix - - - - - + |> after_parsing_impl ppf outputprefix let make_structure_item ~ns cunit : Parsetree.structure_item = - let open Ast_helper in - let loc = Location.none in - Str.module_ - (Mb.mk {txt = cunit; loc } - (Mod.ident - {txt = Lident - ( Ext_namespace.make ~ns cunit) - ; loc})) - - -(** decoding [.mlmap] - keep in sync {!Bsb_namespace_map_gen.output} -*) -let implementation_map ppf sourcefile outputprefix = - let () = Js_config.cmj_only := true in - let ichan = open_in_bin sourcefile in - seek_in ichan (Ext_digest.length +1); - let list_of_modules = Ext_io.rev_lines_of_chann ichan in + let open Ast_helper in + let loc = Location.none in + Str.module_ + (Mb.mk { txt = cunit; loc } + (Mod.ident { txt = Lident (Ext_namespace.make ~ns cunit); loc })) + + +(** decoding [.mlmap] keep in sync {!Bsb_namespace_map_gen.output} *) +let implementation_map ppf sourcefile outputprefix = + let () = Js_config.cmj_only := true in + let ichan = open_in_bin sourcefile in + seek_in ichan (Ext_digest.length + 1); + let list_of_modules = Ext_io.rev_lines_of_chann ichan in close_in ichan; let ns = Ext_filename.module_name sourcefile in - let ml_ast = Ext_list.fold_left list_of_modules [] (fun acc line -> - if Ext_string.is_empty line then acc - else make_structure_item ~ns line :: acc - ) in + let ml_ast = + Ext_list.fold_left list_of_modules [] (fun acc line -> + if Ext_string.is_empty line then acc + else make_structure_item ~ns line :: acc) + in Compmisc.init_path false; ml_ast |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix - + |> after_parsing_impl ppf outputprefix diff --git a/jscomp/core/js_name_of_module_id.ml b/jscomp/core/js_name_of_module_id.ml index ebc8c69171..66afee5ce5 100644 --- a/jscomp/core/js_name_of_module_id.ml +++ b/jscomp/core/js_name_of_module_id.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,196 +17,181 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* -let (=) (x : int) (y:float) = assert false -*) -(* "xx/lib/ocaml/js.cmj" - Enhancement: This can be delegated to build system -*) -let runtime_package_path : string Lazy.t = - lazy (Filename.dirname (Filename.dirname - (Filename.dirname - (match Config_util.find_opt "js.cmj" with - | None -> assert false - | Some x -> x)))) +(* "xx/lib/ocaml/js.cmj" Enhancement: This can be delegated to build system *) +let runtime_package_path : string Lazy.t = + lazy + (Filename.dirname + (Filename.dirname + (Filename.dirname + ( match Config_util.find_opt "js.cmj" with + | None -> assert false + | Some x -> x )))) -let (//) = Filename.concat +let ( // ) = Filename.concat -let fix_path_for_windows : string -> string = +let fix_path_for_windows : string -> string = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_backward_slash - else fun s -> s - - -let get_runtime_module_path - (dep_module_id : Lam_module_ident.t) - (current_package_info : Js_packages_info.t) - module_system = - let current_info_query = - Js_packages_info.query_package_infos current_package_info - module_system in - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name Little_js in - match current_info_query with + else fun s -> s + + +let get_runtime_module_path (dep_module_id : Lam_module_ident.t) + (current_package_info : Js_package_info.t) module_system = + let loc = + Js_package_info.query_package_location_by_module_system current_package_info + module_system + in + let js_file = + Ext_namespace.js_filename_of_modulename ~name:dep_module_id.id.name + ~ext:".js" Lower + in + match loc with | Package_not_found -> assert false - | Package_script -> - Js_packages_info.runtime_package_path module_system js_file - | Package_found pkg -> - let dep_path = - "lib" // Js_packages_info.runtime_dir_of_module_system module_system in - if Js_packages_info.is_runtime_package current_package_info then - Ext_path.node_rebase_file - ~from:pkg.rel_path - ~to_:dep_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - match module_system with - | NodeJS | Es6 -> - Js_packages_info.runtime_package_path module_system js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system ) - (Lazy.force runtime_package_path // dep_path // js_file) + | Package_script -> Js_package_info.runtime_package_path module_system js_file + | Package_found pkg -> ( + let dep_path = + "lib" // Js_package_info.runtime_dir_of_module_system module_system + in + if Js_package_info.is_runtime_package current_package_info then + Ext_path.node_rebase_file ~from:pkg.rel_path ~to_:dep_path js_file + (* TODO: we assume that both [x] and [path] could only be relative path + which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + Js_package_info.runtime_package_path module_system js_file + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + HACKING: FIXME maybe we can caching relative package path + calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + (Lazy.force runtime_package_path // dep_path // js_file) ) (* [output_dir] is decided by the command line argument *) -let string_of_module_id - (dep_module_id : Lam_module_ident.t) - ~(output_dir : string ) - (module_system : Js_packages_info.module_system) - : string = - let current_package_info = Js_packages_state.get_packages_info () in - fix_path_for_windows ( - match dep_module_id.kind with +let string_of_module_id (dep_module_id : Lam_module_ident.t) + ~(output_dir : string) ~(ext : string) + (module_system : Js_package_info.module_system) : string = + let current_package_info = Js_current_package_info.get_packages_info () in + fix_path_for_windows + ( match dep_module_id.kind with | External name -> name (* the literal string for external package *) - (** This may not be enough, - 1. For cross packages, we may need settle - down a single js package - 2. We may need es6 path for dead code elimination - But frankly, very few JS packages have no dependency, - so having plugin may sound not that bad - *) - | Runtime -> - get_runtime_module_path dep_module_id current_package_info module_system - | Ml -> - let current_info_query = - Js_packages_info.query_package_infos - current_package_info - module_system - in - match Lam_compile_env.get_package_path_from_cmj dep_module_id with - | (cmj_path, dep_package_info, little) -> - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name little in - let dep_info_query = - Js_packages_info.query_package_infos dep_package_info module_system - in - match dep_info_query, current_info_query with - | Package_not_found , _ -> - Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) - | Package_script , Package_found _ -> - Bs_exception.error (Dependency_script_module_dependent_not js_file) - | (Package_script | Package_found _ ), Package_not_found -> assert false - - | Package_found pkg, Package_script - -> + (* This may not be enough, + + + For cross packages, we may need settle down a single js package + We + may need es6 path for dead code elimination + + But frankly, very few JS packages have no dependency, so having plugin + may sound not that bad *) + | Runtime -> + get_runtime_module_path dep_module_id current_package_info module_system + | Ml -> ( + let query = Js_package_info.query_package_location_by_module_system in + let current_loc = query current_package_info module_system in + match Lam_compile_env.get_package_path_from_cmj dep_module_id with + | cmj_path, dep_package_info, case -> ( + let dep_loc = query dep_package_info module_system in + match (dep_loc, current_loc) with + | Package_not_found, _ -> + Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) + | Package_script, Package_found _ -> + let js_file = + Ext_namespace.js_filename_of_modulename + (* FIXME: Unsure how to infer a useful file-extension here. *) + ~name:dep_module_id.id.name ~ext:"" case + in + Bs_exception.error + (Dependency_script_module_dependent_not js_file) + | (Package_script | Package_found _), Package_not_found -> + assert false + | Package_found dep_pkg, Package_script -> + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in #if BS_NATIVE then - if Filename.is_relative pkg.rel_path then - pkg.pkg_rel_path // js_file - else - pkg.rel_path // js_file + if Filename.is_relative dep_pkg.rel_path then + dep_pkg.pkg_rel_path // js_file + else dep_pkg.rel_path // js_file #else - pkg.pkg_rel_path // js_file + dep_pkg.pkg_rel_path // js_file #end - - | Package_found dep_pkg, - Package_found cur_pkg -> - if Js_packages_info.same_package_by_name current_package_info dep_package_info then - Ext_path.node_rebase_file - ~from:cur_pkg.rel_path - ~to_:dep_pkg.rel_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - begin match module_system with - | NodeJS | Es6 -> + | Package_found dep_pkg, Package_found cur_pkg -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in + if + Js_package_info.same_package_by_name current_package_info + dep_package_info + then + Ext_path.node_rebase_file ~from:cur_pkg.rel_path + ~to_:dep_pkg.rel_path js_file + (* TODO: we assume that both [x] and [path] could only be + relative path which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> #if BS_NATIVE then - if Filename.is_relative dep_pkg.rel_path then - dep_pkg.pkg_rel_path // js_file - else - dep_pkg.rel_path // js_file + if Filename.is_relative dep_pkg.rel_path then + dep_pkg.pkg_rel_path // js_file + else dep_pkg.rel_path // js_file #else - dep_pkg.pkg_rel_path // js_file + dep_pkg.pkg_rel_path // js_file #end - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - - begin - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system - ) - ((Filename.dirname - (Filename.dirname (Filename.dirname cmj_path))) // dep_pkg.rel_path // js_file) - end - end - | Package_script, Package_script - -> - match Config_util.find_opt js_file with - | Some file -> - let basename = Filename.basename file in - let dirname = Filename.dirname file in - Ext_path.node_rebase_file - ~from:( - Ext_path.absolute_cwd_path - output_dir) - ~to_:( - Ext_path.absolute_cwd_path - - dirname) - basename - | None -> - Bs_exception.error (Js_not_found js_file)) - - + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package + path calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + ( Filename.dirname + (Filename.dirname (Filename.dirname cmj_path)) + // dep_pkg.rel_path // js_file ) ) + | Package_script, Package_script -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext case + in + match Config_util.find_opt js_file with + | Some file -> + let basename = Filename.basename file in + let dirname = Filename.dirname file in + Ext_path.node_rebase_file + ~from:(Ext_path.absolute_cwd_path output_dir) + ~to_:(Ext_path.absolute_cwd_path dirname) + basename + | None -> Bs_exception.error (Js_not_found js_file) ) ) ) ) + (* Override it in browser *) -#if BS_COMPILER_IN_BROWSER then -let string_of_module_id_in_browser (x : Lam_module_ident.t) = - match x.kind with - | External name -> name - | Runtime | Ml -> - "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" -let string_of_module_id - (id : Lam_module_ident.t) - ~output_dir:(_:string) - (_module_system : Js_packages_info.module_system) - = string_of_module_id_in_browser id +#if BS_COMPILER_IN_BROWSER then +let string_of_module_id_in_browser (x : Lam_module_ident.t) = + match x.kind with + | External name -> name + | Runtime | Ml -> + "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" + + +let string_of_module_id (id : Lam_module_ident.t) ~output_dir:(_ : string) + ~ext:(_ : string) (_module_system : Js_package_info.module_system) = + string_of_module_id_in_browser id #end diff --git a/jscomp/core/js_name_of_module_id.mli b/jscomp/core/js_name_of_module_id.mli index 92bb7fc45f..0975365e2f 100644 --- a/jscomp/core/js_name_of_module_id.mli +++ b/jscomp/core/js_name_of_module_id.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,22 +17,19 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** - generate the mdoule path so that it can be spliced here: - {[ - var Xx = require("package/path/to/xx.js") - ]} - Note that it has to be consistent to how it is generated -*) - -val string_of_module_id : +val string_of_module_id : Lam_module_ident.t -> output_dir:string -> - Js_packages_info.module_system -> - string \ No newline at end of file + ext:string -> + Js_package_info.module_system -> + string +(** generate the mdoule path so that it can be spliced here: + + {[ var Xx = require "package/path/to/xx.js" ]} + + Note that it has to be consistent to how it is generated *) diff --git a/jscomp/core/js_package_info.ml b/jscomp/core/js_package_info.ml new file mode 100644 index 0000000000..190ff5d683 --- /dev/null +++ b/jscomp/core/js_package_info.ml @@ -0,0 +1,224 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +[@@@ocaml.warning "+9"] + +type path = string + +type module_system = + | NodeJS + | Es6 + (* ignore node_modules, just calcluating relative path *) + | Es6_global + +(* ocamlopt could not optimize such simple case... *) +let compatible (dep : module_system) (query : module_system) = + match query with + | NodeJS -> dep = NodeJS + | Es6 -> dep = Es6 + (* As a dependency Leaf Node, it is the same either [global] or [not] *) + | Es6_global -> dep = Es6_global || dep = Es6 + + +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} + +type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string + +let deprecated_use_bs_extension = ref false + +let runtime_package_name = "bs-platform" + +let ( // ) = Filename.concat + +(* in runtime lib, [es6] and [es6-global] are treated the same way *) +let runtime_dir_of_module_system (ms : module_system) = + match ms with + | NodeJS -> "js" + | Es6 | Es6_global -> "es6" + + +let runtime_package_path (ms : module_system) js_file = + runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file + + +type t = { name : package_name; locations : location_descriptor list } + +let same_package_by_name (x : t) (y : t) = x.name = y.name + +let is_runtime_package (x : t) = x.name = Pkg_runtime + +let iter (x : t) = Ext_list.iter x.locations + +(* TODO: not allowing user to provide such specific package name For empty + package, [-bs-package-output] does not make sense it is only allowed to + generate commonjs file in the same directory *) +let empty : t = { name = Pkg_empty; locations = [] } + +let from_name (name : string) = + if name = runtime_package_name then { name = Pkg_runtime; locations = [] } + else { name = Pkg_normal name; locations = [] } + + +let is_empty (x : t) = x.name = Pkg_empty + +let string_of_module_system (ms : module_system) = + match ms with + | NodeJS -> "NodeJS" + | Es6 -> "Es6" + | Es6_global -> "Es6_global" + + +let module_system_of_string package_name : module_system option = + match package_name with + | "commonjs" -> Some NodeJS + | "es6" -> Some Es6 + | "es6-global" -> Some Es6_global + | _ -> None + + +let dump_location_descriptor (fmt : Format.formatter) + { module_system = ms; path; extension } = + Format.fprintf fmt "@[%s:@ %s:@ %s@]" + (string_of_module_system ms) + path extension + + +let dump_package_name fmt (x : package_name) = + match x with + | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" + | Pkg_normal s -> Format.pp_print_string fmt s + | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name + + +let dump_package_info (fmt : Format.formatter) ({ name; locations } : t) = + Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) + dump_location_descriptor) + locations + + +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +(* Note that package-name has to be exactly the same as npm package name, + otherwise the path resolution will be wrong *) +let query_package_location_by_module_system ({ name; locations } : t) + (module_system : module_system) : query_result = + match name with + | Pkg_empty -> Package_script + | Pkg_normal name -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + | Pkg_runtime -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = runtime_package_name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + + +let get_js_path (x : t) module_system = + match + Ext_list.find_first x.locations (fun k -> + compatible k.module_system module_system) + with + | Some k -> k.path + | None -> assert false + + +(* for a single pass compilation, [output_dir] can be cached *) +let get_output_dir (info : t) ~package_dir module_system = + Filename.concat package_dir (get_js_path info module_system) + + +let deprecated_set_bs_extension () = + Bs_warnings.warn_deprecated_bs_suffix_flag (); + deprecated_use_bs_extension := true + + +let deprecated_get_default_extension () = + if !deprecated_use_bs_extension then Literals.suffix_bs_js + else Literals.suffix_js + + +(* FIXME: The deprecated -bs-suffix will only affect -bs-package-output flags + passed *after* it. *) +let append_location_descriptor_of_string (packages_info : t) (s : string) : t = + let module_system, path, extension = + match Ext_string.split ~keep_empty:false s ':' with + | [ module_system; path; extension ] -> (module_system, path, extension) + (* Note that, for most users, the default values for [module_system] and + [extension] come not from here, but from [bsb], which always invokes this + with a fully-populated [-bs-package-output]. + + If you're changing the default, make sure both places match! *) + | [ module_system; path ] -> + (module_system, path, deprecated_get_default_extension ()) + | [ path ] -> ("NodeJS", path, deprecated_get_default_extension ()) + | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s + in + let module_system = + match module_system_of_string module_system with + | Some x -> x + | None -> + Ext_arg.bad_argf "invalid module system in -bs-package-output: %s" + module_system + in + { + packages_info with + locations = { module_system; path; extension } :: packages_info.locations; + } + +(* support es6 modules instead + + TODO: enrich ast to support import export + http://www.ecma-international.org/ecma-262/6.0/#sec-imports For every module, + we need [Ident.t] for accessing and [filename] for import, they are not + necessarily the same. + + Es6 modules is not the same with commonjs, we use commonjs currently (play + better with node) + + FIXME: the module order matters? *) diff --git a/jscomp/core/js_packages_info.mli b/jscomp/core/js_package_info.mli similarity index 53% rename from jscomp/core/js_packages_info.mli rename to jscomp/core/js_package_info.mli index 89fc6c96b5..7d060378ed 100644 --- a/jscomp/core/js_packages_info.mli +++ b/jscomp/core/js_package_info.mli @@ -22,85 +22,50 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type module_system = NodeJS | Es6 | Es6_global -type module_system = - | NodeJS - | Es6 - | Es6_global - - -val runtime_dir_of_module_system : - module_system -> - string - -val runtime_package_path: - module_system -> - string -> - string - -type package_info - = - { - module_system : module_system ; - path : string - } - -type t - -val is_runtime_package: - t -> - bool - -val same_package_by_name : - t -> - t -> - bool - -val iter : - t -> - (package_info -> unit) -> - unit - -val empty : t -val from_name : string -> t -val is_empty : t -> bool - -val dump_packages_info : - Format.formatter -> t -> unit - - -(** used by command line option - e.g [-bs-package-output commonjs:xx/path] -*) -val add_npm_package_path : - t -> - string -> - t - -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } - -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -val get_output_dir: - t -> - package_dir:string -> - module_system -> - string - -val query_package_infos: - t -> - module_system -> - info_query -(** Note here we compare the package info by order - in theory, we can compare it by set semantics -*) +val runtime_dir_of_module_system : module_system -> string +val runtime_package_path : module_system -> string -> string +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} + +type t + +val is_runtime_package : t -> bool + +val same_package_by_name : t -> t -> bool + +val iter : t -> (location_descriptor -> unit) -> unit + +val empty : t +val from_name : string -> t +val is_empty : t -> bool + +val dump_package_info : Format.formatter -> t -> unit + +val deprecated_set_bs_extension : unit -> unit + +val append_location_descriptor_of_string : t -> string -> t +(** used by command line option e.g [-bs-package-output commonjs:xx/path:ext] *) + +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} + +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +val get_output_dir : t -> package_dir:string -> module_system -> string + +(* Note here we compare the package info by order in theory, we can compare it + by set semantics *) +val query_package_location_by_module_system : t -> module_system -> query_result diff --git a/jscomp/core/js_packages_info.ml b/jscomp/core/js_packages_info.ml deleted file mode 100644 index 8f3d134025..0000000000 --- a/jscomp/core/js_packages_info.ml +++ /dev/null @@ -1,262 +0,0 @@ -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -[@@@ocaml.warning "+9"] - -type path = string - -type module_system = - | NodeJS - | Es6 - | Es6_global (* ignore node_modules, just calcluating relative path *) - - -(* ocamlopt could not optimize such simple case..*) -let compatible (dep : module_system) - (query : module_system) = - match query with - | NodeJS -> dep = NodeJS - | Es6 -> dep = Es6 - | Es6_global - -> dep = Es6_global || dep = Es6 -(* As a dependency Leaf Node, it is the same either [global] or [not] *) - - -type package_info = - { module_system : module_system ; path : string } - -type package_name = - | Pkg_empty - | Pkg_runtime - | Pkg_normal of string - - - -let runtime_package_name = "bs-platform" - - -let (//) = Filename.concat - -(* in runtime lib, [es6] and [es6] are treated the same wway *) -let runtime_dir_of_module_system (ms : module_system ) = - match ms with - | NodeJS -> "js" - | Es6 | Es6_global -> "es6" - -let runtime_package_path - (ms : module_system) - js_file = - runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file - - -type t = - { - name : package_name ; - module_systems: package_info list - } - -let same_package_by_name (x : t) (y : t) = x.name = y.name - -let is_runtime_package (x : t) = - x.name = Pkg_runtime - -let iter (x : t) cb = - Ext_list.iter x.module_systems cb - -(* let equal (x : t) ({name; module_systems}) = - x.name = name && - Ext_list.for_all2_no_exn - x.module_systems module_systems - (fun (a0,a1) (b0,b1) -> a0 = b0 && a1 = b1) *) - -(* we don't want force people to use package *) - -(** - TODO: not allowing user to provide such specific package name - For empty package, [-bs-package-output] does not make sense - it is only allowed to generate commonjs file in the same directory -*) -let empty : t = - { name = Pkg_empty ; - module_systems = [] - } - -let from_name (name : string) = - if name = runtime_package_name then - { - name = Pkg_runtime ; module_systems = [] - } - else - { - name = Pkg_normal name ; - module_systems = [] - } - -let is_empty (x : t) = - x.name = Pkg_empty - - -let string_of_module_system (ms : module_system) = - match ms with - | NodeJS -> "NodeJS" - | Es6 -> "Es6" - | Es6_global -> "Es6_global" - - -let module_system_of_string package_name : module_system option = - match package_name with - | "commonjs" -> Some NodeJS - | "es6" -> Some Es6 - | "es6-global" -> Some Es6_global - | _ -> None - -let dump_package_info - (fmt : Format.formatter) - ({module_system = ms; path = name} : package_info) - = - Format.fprintf - fmt - "@[%s:@ %s@]" - (string_of_module_system ms) - name - -let dump_package_name fmt (x : package_name) = - match x with - | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" - | Pkg_normal s -> Format.pp_print_string fmt s - | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name - -let dump_packages_info - (fmt : Format.formatter) - ({name ; module_systems = ls } : t) = - Format.fprintf fmt "@[%a;@ @[%a@]@]" - dump_package_name - name - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) - dump_package_info - ) ls - -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -(* Note that package-name has to be exactly the same as - npm package name, otherwise the path resolution will be wrong *) -let query_package_infos - ({name; module_systems } : t) - (module_system : module_system) : info_query = - match name with - | Pkg_empty -> - Package_script - | Pkg_normal name -> - (match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found) - | Pkg_runtime -> - match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = runtime_package_name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found - - - -let get_js_path - (x : t ) - module_system - = - match Ext_list.find_first x.module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> k.path - | None -> assert false - -(* for a single pass compilation, [output_dir] - can be cached -*) -let get_output_dir - (info: t ) - ~package_dir module_system - = - Filename.concat package_dir - (get_js_path info module_system) - - - - -let add_npm_package_path (packages_info : t) (s : string) : t = - if is_empty packages_info then - Ext_arg.bad_argf "please set package name first using -bs-package-name " - else - let module_system, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ module_system; path] -> - (match module_system_of_string module_system with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" module_system), path - | [path] -> - NodeJS, path - | module_system :: path -> - (match module_system_of_string module_system with - | Some x -> x - | None -> Ext_arg.bad_argf "invalid module system %s" module_system), (String.concat ":" path) - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - { packages_info with module_systems = {module_system; path}::packages_info.module_systems} - -(* support es6 modules instead - TODO: enrich ast to support import export - http://www.ecma-international.org/ecma-262/6.0/#sec-imports - For every module, we need [Ident.t] for accessing and [filename] for import, - they are not necessarily the same. - - Es6 modules is not the same with commonjs, we use commonjs currently - (play better with node) - - FIXME: the module order matters? -*) - diff --git a/jscomp/core/lam_compile_env.ml b/jscomp/core/lam_compile_env.ml index 939fd97aa3..2505be2c24 100644 --- a/jscomp/core/lam_compile_env.ml +++ b/jscomp/core/lam_compile_env.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,197 +17,132 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - - -module E = Js_exp_make +module E = Js_exp_make module S = Js_stmt_make - -type env_value = +type env_value = | Ml of Js_cmj_load.cmj_load_info - | Runtime of Js_cmj_load.cmj_load_info - (** - [Runtime (pure, path, cmj_format)] - A built in module probably from our runtime primitives, - so it does not have any [signature] - - *) - | External - (** Also a js file, but this belong to third party - *) - - - + | Runtime of Js_cmj_load.cmj_load_info + (** [Runtime (pure, path, cmj_format)] A built in module probably from our + runtime primitives, so it does not have any [signature] *) + | External (** Also a js file, but this belong to third party *) type ident_info = { name : string; - arity : Js_cmj_format.arity; - closed_lambda : Lam.t option + arity : Js_cmj_format.arity; + closed_lambda : Lam.t option; } -(* - refer: [Env.find_pers_struct] - [ find_in_path_uncap !load_path (name ^ ".cmi")] -*) +(* refer: [Env.find_pers_struct] [ find_in_path_uncap !load_path (name ^ + ".cmi")] *) +let cached_tbl : env_value Lam_module_ident.Hash.t = + Lam_module_ident.Hash.create 31 -let cached_tbl : env_value Lam_module_ident.Hash.t - = Lam_module_ident.Hash.create 31 -let (+>) = Lam_module_ident.Hash.add cached_tbl - +let ( +> ) = Lam_module_ident.Hash.add cached_tbl (* For each compilation we need reset to make it re-entrant *) -let reset () = +let reset () = Translmod.reset (); - Lam_module_ident.Hash.clear cached_tbl - - - - - -(** We should not provide "#moduleid" as output - since when we print it in the end, it will - be escaped quite ugly -*) -let add_js_module - (hint_name : External_ffi_types.module_bind_name) - (module_name : string) : Ident.t - = - let id = - Ident.create - (match hint_name with - | Phint_name hint_name -> - Ext_string.capitalize_ascii hint_name - (* make sure the module name is capitalized - TODO: maybe a warning if the user hint is not good - *) - | Phint_nothing -> - Ext_modulename.js_id_name_of_hint_name module_name - ) + Lam_module_ident.Hash.clear cached_tbl + + +(** We should not provide "#moduleid" as output since when we print it in the + end, it will be escaped quite ugly *) +let add_js_module (hint_name : External_ffi_types.module_bind_name) + (module_name : string) : Ident.t = + let id = + Ident.create + ( match hint_name with + | Phint_name hint_name -> Ext_string.capitalize_ascii hint_name + (* make sure the module name is capitalized TODO: maybe a warning if the + user hint is not good *) + | Phint_nothing -> Ext_modulename.js_id_name_of_hint_name module_name ) in - let lam_module_ident = - Lam_module_ident.of_external id module_name in - match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with + let lam_module_ident = Lam_module_ident.of_external id module_name in + match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with | None -> - Lam_module_ident.Hash.add - cached_tbl - lam_module_ident - External; - id - | Some old_key -> - old_key.id - - - - + Lam_module_ident.Hash.add cached_tbl lam_module_ident External; + id + | Some old_key -> old_key.id let query_external_id_info (module_id : Ident.t) (name : string) : ident_info = - let oid = Lam_module_ident.of_ml module_id in - let cmj_table = - match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - let cmj_load_info = - Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in - oid +> Ml cmj_load_info ; - cmj_load_info.cmj_table - | Some (Ml { cmj_table } ) - -> cmj_table + let oid = Lam_module_ident.of_ml module_id in + let cmj_table = + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> + let cmj_load_info = + Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) + in + oid +> Ml cmj_load_info; + cmj_load_info.cmj_table + | Some (Ml { cmj_table }) -> cmj_table | Some (Runtime _) -> assert false - | Some External -> assert false in - let arity , closed_lambda = - Js_cmj_format.query_by_name cmj_table name + | Some External -> assert false in - { - name; - arity; - closed_lambda - (* TODO shall we cache the arity ?*) - } - - - - - + let arity, closed_lambda = Js_cmj_format.query_by_name cmj_table name in + { name; arity; closed_lambda (* TODO shall we cache the arity ?*) } + + +let get_package_path_from_cmj (id : Lam_module_ident.t) = + match Lam_module_ident.Hash.find_opt cached_tbl id with + | Some (Ml { cmj_table; cmj_path }) -> + ( cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) + | Some (External | Runtime _) -> + assert false + (* called by {!Js_name_of_module_id.string_of_module_id} can not be + External *) + | None -> ( + match id.kind with + | Runtime | External _ -> assert false + | Ml -> + let ({ Js_cmj_load.cmj_table } as cmj_load_info) = + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name id ^ Literals.suffix_cmj) + in + id +> Ml cmj_load_info; + ( cmj_load_info.cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) ) - - - - -let get_package_path_from_cmj - ( id : Lam_module_ident.t) - = - match Lam_module_ident.Hash.find_opt cached_tbl id with - | Some (Ml {cmj_table ; cmj_path}) -> - (cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - | Some ( - External | - Runtime _ ) -> - assert false - (* called by {!Js_name_of_module_id.string_of_module_id} - can not be External - *) - | None -> - begin match id.kind with - | Runtime - | External _ -> assert false - | Ml -> - let ({Js_cmj_load.cmj_table} as cmj_load_info) = - Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in - id +> Ml cmj_load_info; - (cmj_load_info.cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - end - let add = Lam_module_ident.Hash_set.add - - (* Conservative interface *) -let is_pure_module (oid : Lam_module_ident.t) = - match oid.kind with - | Runtime -> true +let is_pure_module (oid : Lam_module_ident.t) = + match oid.kind with + | Runtime -> true | External _ -> false - | Ml -> - begin match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - begin - match Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) with - | cmj_load_info -> - oid +> Ml cmj_load_info ; - Js_cmj_format.is_pure cmj_load_info.cmj_table - | exception _ -> false - end - | Some (Ml{cmj_table}|Runtime {cmj_table}) -> - Js_cmj_format.is_pure cmj_table - | Some External -> false - end - - -let get_required_modules - extras - (hard_dependencies - : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list = - Lam_module_ident.Hash.iter cached_tbl (fun id _ -> - if not @@ is_pure_module id - then add hard_dependencies id); - Lam_module_ident.Hash_set.iter extras (fun id -> - (if not @@ is_pure_module id - then add hard_dependencies id : unit) - ); + | Ml -> ( + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> ( + match + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name oid ^ Literals.suffix_cmj) + with + | cmj_load_info -> + oid +> Ml cmj_load_info; + Js_cmj_format.is_pure cmj_load_info.cmj_table + | exception _ -> false ) + | Some (Ml { cmj_table } | Runtime { cmj_table }) -> + Js_cmj_format.is_pure cmj_table + | Some External -> false ) + + +let get_required_modules extras + (hard_dependencies : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list + = + Lam_module_ident.Hash.iter cached_tbl (fun id _ -> + if not @@ is_pure_module id then add hard_dependencies id); + Lam_module_ident.Hash_set.iter extras (fun id -> + (if not @@ is_pure_module id then add hard_dependencies id : unit)); Lam_module_ident.Hash_set.elements hard_dependencies diff --git a/jscomp/core/lam_compile_env.mli b/jscomp/core/lam_compile_env.mli index d8a0ab3699..49609496e3 100644 --- a/jscomp/core/lam_compile_env.mli +++ b/jscomp/core/lam_compile_env.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,88 +17,61 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** Helper for global Ocaml module index into meaningful names *) - - - - +(** Helper for global Ocaml module index into meaningful names *) type ident_info = { name : string; arity : Js_cmj_format.arity; - closed_lambda : Lam.t option -} + closed_lambda : Lam.t option; +} +val reset : unit -> unit +val add_js_module : External_ffi_types.module_bind_name -> string -> Ident.t +(** [add_js_module hint_name module_name] Given a js module name and hint name, + assign an id to it we also bookkeep it as [External] dependency. + Note the complexity lies in that we should consolidate all same external + dependencies into a single dependency. -val reset : unit -> unit + The strategy is that we first create a [Lam_module_ident.t] and query it if + already exists in [cache_tbl], if it already exists, we discard the freshly + made one, and use the cached one, otherwise, use the freshly made one + instead -(** - [add_js_module hint_name module_name] - Given a js module name and hint name, assign an id to it - we also bookkeep it as [External] dependency. + Invariant: any [id] as long as put in the [cached_tbl] should be always + valid, *) - Note the complexity lies in that we should consolidate all - same external dependencies into a single dependency. - - The strategy is that we first create a [Lam_module_ident.t] - and query it if already exists in [cache_tbl], if it already - exists, we discard the freshly made one, and use the cached one, - otherwise, use the freshly made one instead +(* The other dependencies are captured by querying either when [access] or when + expansion, however such dependency can be removed after inlining etc. - Invariant: - any [id] as long as put in the [cached_tbl] should be always valid, -*) -val add_js_module : - External_ffi_types.module_bind_name -> string -> Ident.t + When we register such compile time dependency we classified it as Visit (ml), + Builtin(built in js), External() + For external, we never remove, we only consider remove dependency for Runtime + and Visit, so when compile OCaml to Javascript, we only need pay attention to + for those modules are actually used or not *) -(* The other dependencies are captured by querying - either when [access] or when expansion, - however such dependency can be removed after inlining etc. - - When we register such compile time dependency we classified - it as - Visit (ml), Builtin(built in js), External() - - For external, we never remove, we only consider - remove dependency for Runtime and Visit, so - when compile OCaml to Javascript, we only need - pay attention to for those modules are actually used or not -*) -(** - [query_external_id_info id pos env found] - will raise if not found -*) -val query_external_id_info : - Ident.t -> - string -> - ident_info - +val query_external_id_info : Ident.t -> string -> ident_info +(** [query_external_id_info id pos env found] will raise if not found *) val is_pure_module : Lam_module_ident.t -> bool +val get_package_path_from_cmj : + Lam_module_ident.t -> string * Js_package_info.t * Ext_namespace.leading_case -val get_package_path_from_cmj : - Lam_module_ident.t -> - (string * Js_packages_info.t * Js_cmj_format.cmj_case) - - +val get_required_modules : + Lam_module_ident.Hash_set.t -> + Lam_module_ident.Hash_set.t -> + Lam_module_ident.t list +(** The second argument is mostly from [runtime] modules -(* The second argument is mostly from [runtime] modules will change the input [hard_dependencies] - [get_required_modules extra hard_dependencies] - [extra] maybe removed if it is pure and not in [hard_dependencies] -*) -val get_required_modules : - Lam_module_ident.Hash_set.t -> - Lam_module_ident.Hash_set.t -> - Lam_module_ident.t list + + [get_required_modules extra hard_dependencies] - [extra] maybe removed if it + is pure and not in [hard_dependencies] *) diff --git a/jscomp/core/lam_compile_main.ml b/jscomp/core/lam_compile_main.ml index 2e6a177a6c..d752bb6766 100644 --- a/jscomp/core/lam_compile_main.ml +++ b/jscomp/core/lam_compile_main.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,320 +17,276 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +module E = Js_exp_make +module S = Js_stmt_make +let get_leading_case output_prefix : Ext_namespace.leading_case = + if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Lower + else Upper +let compile_group (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = + match x with + (* We need: 1. [E.builtin_dot] for javascript builtin, 2. [E.mldot] *) + (* ATTENTION: check {!Lam_compile_global} for consistency *) + (* Special handling for values in [Pervasives] *) + (* we delegate [stdout, stderr, and stdin] into [caml_io] module, the + motivation is to help dead code eliminatiion, it's helpful to make those + parts pure (not a function call), then it can be removed if unused *) + (* QUICK hack to make hello world example nicer, Note the arity of + [print_endline] is already analyzed before, so it should be safe *) + | Single (kind, id, lam) -> + (* let lam = Optimizer.simplify_lets [] lam in *) + (* can not apply again, it's wrong USE it with care *) + (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) + Lam_compile.compile_lambda + { + continuation = Declare (kind, id); + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam + | Recursive id_lams -> + Lam_compile.compile_recursive_lets + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + id_lams + | Nop lam -> + (* TODO: Side effect callls, log and see statistics *) + Lam_compile.compile_lambda + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam +(* Also need analyze its depenency is pure or not *) +let no_side_effects (rest : Lam_group.t list) : string option = + Ext_list.find_opt rest (fun x -> + match x with + | Single (kind, id, body) -> ( + match kind with + | Strict | Variable -> + if not @@ Lam_analysis.no_side_effects body then + Some (Printf.sprintf "%s" id.name) + else None + | _ -> None ) + | Recursive bindings -> + Ext_list.find_opt bindings (fun (id, lam) -> + if not @@ Lam_analysis.no_side_effects lam then + Some (Printf.sprintf "%s" id.Ident.name) + else None) + | Nop lam -> + if not @@ Lam_analysis.no_side_effects lam then + (* (Lam_util.string_of_lambda lam) *) + Some "" + else None + (* TODO :*)) -module E = Js_exp_make -module S = Js_stmt_make - -let get_cmj_case output_prefix : Ext_namespace.file_kind = - let little = - Ext_char.is_lower_case (Filename.basename output_prefix).[0] - in - match little, !Js_config.bs_suffix with - | true, true -> Little_bs - | true, false -> Little_js - | false, true -> Upper_bs - | false, false -> Upper_js - - -let compile_group (meta : Lam_stats.t) - (x : Lam_group.t) : Js_output.t = - match x with - (* - We need - - 2. [E.builtin_dot] for javascript builtin - 3. [E.mldot] - *) - (* ATTENTION: check {!Lam_compile_global} for consistency *) - (** Special handling for values in [Pervasives] *) - (* - we delegate [stdout, stderr, and stdin] into [caml_io] module, - the motivation is to help dead code eliminatiion, it's helpful - to make those parts pure (not a function call), then it can be removed - if unused - *) - - (* QUICK hack to make hello world example nicer, - Note the arity of [print_endline] is already analyzed before, - so it should be safe - *) - - | Single (kind, id, lam) -> - (* let lam = Optimizer.simplify_lets [] lam in *) - (* can not apply again, it's wrong USE it with care*) - (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda { continuation = Declare (kind, id); - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - - | Recursive id_lams -> - Lam_compile.compile_recursive_lets - { continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } - id_lams - | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda {continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - -;; - (** Also need analyze its depenency is pure or not *) -let no_side_effects (rest : Lam_group.t list) : string option = - Ext_list.find_opt rest (fun x -> - match x with - | Single(kind,id,body) -> - begin - match kind with - | Strict | Variable -> - if not @@ Lam_analysis.no_side_effects body - then Some (Printf.sprintf "%s" id.name) - else None - | _ -> None - end - | Recursive bindings -> - Ext_list.find_opt bindings (fun (id,lam) -> - if not @@ Lam_analysis.no_side_effects lam - then Some (Printf.sprintf "%s" id.Ident.name ) - else None - ) - | Nop lam -> - if not @@ Lam_analysis.no_side_effects lam - then - (* (Lam_util.string_of_lambda lam) *) - Some "" - else None (* TODO :*)) - - -let _d = fun s lam -> -#if undefined BS_RELEASE_BUILD then - Lam_util.dump s lam ; - Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s; - ignore @@ Lam_check.check !Location.input_name lam; - Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s; +let _d s lam = +#if undefined BS_RELEASE_BUILD then + Lam_util.dump s lam; + Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s; + ignore @@ Lam_check.check !Location.input_name lam; + Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s; #end - lam + lam + -let _j = Js_pass_debug.dump +let _j = Js_pass_debug.dump -(** Actually simplify_lets is kind of global optimization since it requires you to know whether - it's used or not -*) -let compile - (output_prefix : string) - (lam : Lambda.lambda) = - let export_idents = Translmod.get_export_identifiers() in - let export_ident_sets = Set_ident.of_list export_idents in +(* Actually simplify_lets is kind of global optimization since it requires you + to know whether it's used or not *) +let compile (output_prefix : string) (lam : Lambda.lambda) = + let export_idents = Translmod.get_export_identifiers () in + let export_ident_sets = Set_ident.of_list export_idents in (* To make toplevel happy - reentrant for js-demo *) - let () = -#if undefined BS_RELEASE_BUILD then - Ext_list.iter export_idents - (fun id -> Ext_log.dwarn ~__POS__ "export idents: %s/%d" id.name id.stamp) ; -#end - Lam_compile_env.reset () ; - in - let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + let () = +#if undefined BS_RELEASE_BUILD then + Ext_list.iter export_idents (fun id -> + Ext_log.dwarn ~__POS__ "export idents: %s/%d" id.name id.stamp); +#end + Lam_compile_env.reset () + in + let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in - - let lam = _d "initial" lam in - let lam = Lam_pass_deep_flatten.deep_flatten lam in - let lam = _d "flatten0" lam in - let meta : Lam_stats.t = - Lam_stats.make - ~export_idents - ~export_ident_sets in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - let lam = - lam - |> _d "flattern1" - |> Lam_pass_exits.simplify_exits + let lam = _d "initial" lam in + let lam = Lam_pass_deep_flatten.deep_flatten lam in + let lam = _d "flatten0" lam in + let meta : Lam_stats.t = Lam_stats.make ~export_idents ~export_ident_sets in + let () = Lam_pass_collect.collect_info meta lam in + let lam = + let lam = + lam |> _d "flattern1" |> Lam_pass_exits.simplify_exits |> _d "simplyf_exits" - |> (fun lam -> Lam_pass_collect.collect_info meta lam; lam) - |> Lam_pass_remove_alias.simplify_alias meta - |> _d "simplify_alias" - |> Lam_pass_deep_flatten.deep_flatten - |> _d "flatten2" - in (* Inling happens*) + |> (fun lam -> + Lam_pass_collect.collect_info meta lam; + lam) + |> Lam_pass_remove_alias.simplify_alias meta + |> _d "simplify_alias" |> Lam_pass_deep_flatten.deep_flatten + |> _d "flatten2" + in - let () = Lam_pass_collect.collect_info meta lam in - let lam = Lam_pass_remove_alias.simplify_alias meta lam in + (* Inling happens*) + let () = Lam_pass_collect.collect_info meta lam in + let lam = Lam_pass_remove_alias.simplify_alias meta lam in let lam = Lam_pass_deep_flatten.deep_flatten lam in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - lam - |> _d "alpha_before" + let () = Lam_pass_collect.collect_info meta lam in + let lam = + lam |> _d "alpha_before" |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "alpha_after" - |> Lam_pass_exits.simplify_exits in + |> _d "alpha_after" |> Lam_pass_exits.simplify_exits + in let () = Lam_pass_collect.collect_info meta lam in - - lam - |> _d "simplify_alias_before" - |> Lam_pass_remove_alias.simplify_alias meta + lam |> _d "simplify_alias_before" + |> Lam_pass_remove_alias.simplify_alias meta |> _d "alpha_conversion" - |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "before-simplify_lets" + |> Lam_pass_alpha_conversion.alpha_conversion meta + |> _d "before-simplify_lets" (* we should investigate a better way to put different passes : )*) - |> Lam_pass_lets_dce.simplify_lets - + |> Lam_pass_lets_dce.simplify_lets |> _d "before-simplify-exits" - (* |> (fun lam -> Lam_pass_collect.collect_info meta lam - ; Lam_pass_remove_alias.simplify_alias meta lam) *) - (* |> Lam_group_pass.scc_pass - |> _d "scc" *) + (* |> (fun lam -> Lam_pass_collect.collect_info meta lam ; + Lam_pass_remove_alias.simplify_alias meta lam) *) + (* |> Lam_group_pass.scc_pass |> _d "scc" *) |> Lam_pass_exits.simplify_exits |> _d "simplify_lets" -#if undefined BS_RELEASE_BUILD then - |> (fun lam -> - let () = - Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta in - Lam_check.check !Location.input_name lam - ) -#end +#if undefined BS_RELEASE_BUILD then + |> fun lam -> + let () = + Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta + in + Lam_check.check !Location.input_name lam +#end in - let ({Lam_coercion.groups = groups } as coerced_input , meta) = - Lam_coercion.coerce_and_group_big_lambda meta lam - in + let ({ Lam_coercion.groups } as coerced_input), meta = + Lam_coercion.coerce_and_group_big_lambda meta lam + in -#if undefined BS_RELEASE_BUILD then +#if undefined BS_RELEASE_BUILD then let () = - Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta ; + Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta; if Js_config.is_same_file () then - let f = - Ext_filename.new_extension !Location.input_name ".lambda" in - Ext_fmt.with_file_as_pp f begin fun fmt -> - Format.pp_print_list ~pp_sep:Format.pp_print_newline - Lam_group.pp_group fmt (coerced_input.groups) - end; + let f = Ext_filename.new_extension !Location.input_name ".lambda" in + Ext_fmt.with_file_as_pp f (fun fmt -> + Format.pp_print_list ~pp_sep:Format.pp_print_newline + Lam_group.pp_group fmt coerced_input.groups) in -#end +#end let maybe_pure = no_side_effects groups in -#if undefined BS_RELEASE_BUILD then - let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." (Sys.time () *. 1000.) in -#end - let body = +#if undefined BS_RELEASE_BUILD then + let () = + Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@." + (Sys.time () *. 1000.) + in +#end + let body = Ext_list.map groups (fun group -> compile_group meta group) - |> Js_output.concat - |> Js_output.output_as_block + |> Js_output.concat |> Js_output.output_as_block in -#if undefined BS_RELEASE_BUILD then - let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Post-compile: %f@]@." (Sys.time () *. 1000.) in -#end - (* The file is not big at all compared with [cmo] *) - (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) - let meta_exports = meta.exports in - let export_set = Set_ident.of_list meta_exports in - let js : J.program = - { - exports = meta_exports ; - export_set; - block = body} +#if undefined BS_RELEASE_BUILD then + let () = + Ext_log.dwarn ~__POS__ "\n@[[TIME:]Post-compile: %f@]@." + (Sys.time () *. 1000.) in - js - |> _j "initial" - |> Js_pass_flatten.program - |> _j "flattern" - |> Js_pass_tailcall_inline.tailcall_inline - |> _j "inline_and_shake" - |> Js_pass_flatten_and_mark_dead.program - |> _j "flatten_and_mark_dead" +#end + (* The file is not big at all compared with [cmo] *) + (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) + let meta_exports = meta.exports in + let export_set = Set_ident.of_list meta_exports in + let js : J.program = { exports = meta_exports; export_set; block = body } in + js |> _j "initial" |> Js_pass_flatten.program |> _j "flattern" + |> Js_pass_tailcall_inline.tailcall_inline |> _j "inline_and_shake" + |> Js_pass_flatten_and_mark_dead.program |> _j "flatten_and_mark_dead" (* |> Js_inline_and_eliminate.inline_and_shake *) (* |> _j "inline_and_shake" *) - |> (fun js -> ignore @@ Js_pass_scope.program js ; js ) - |> Js_shake.shake_program - |> _j "shake" - |> ( fun (program: J.program) -> - let external_module_ids : Lam_module_ident.t list = - if !Js_config.all_module_aliases then [] - else - let x = Lam_compile_env.get_required_modules - may_required_modules - (Js_fold_basic.calculate_hard_dependencies program.block) in - if !Js_config.sort_imports then - Ext_list.sort_via_array x - (fun id1 id2 -> - Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2) - ) - else - x + |> (fun js -> + ignore @@ Js_pass_scope.program js; + js) + |> Js_shake.shake_program |> _j "shake" + |> fun (program : J.program) -> + let external_module_ids : Lam_module_ident.t list = + if !Js_config.all_module_aliases then [] + else + let x = + Lam_compile_env.get_required_modules may_required_modules + (Js_fold_basic.calculate_hard_dependencies program.block) in - Warnings.check_fatal (); - let effect = - Lam_stats_export.get_dependent_module_effect - meta maybe_pure external_module_ids in - let v : Js_cmj_format.t = - Lam_stats_export.export_to_cmj - meta - effect - coerced_input.export_map - (get_cmj_case output_prefix) - in - (if not @@ !Clflags.dont_write_files then - Js_cmj_format.to_file - ~check_exists:(not !Js_config.force_cmj) - (output_prefix ^ Literals.suffix_cmj) v); - {J.program = program ; side_effect = effect ; modules = external_module_ids } - ) -;; + if !Js_config.sort_imports then + Ext_list.sort_via_array x (fun id1 id2 -> + Ext_string.compare + (Lam_module_ident.name id1) + (Lam_module_ident.name id2)) + else x + in + Warnings.check_fatal (); + let effect = + Lam_stats_export.get_dependent_module_effect meta maybe_pure + external_module_ids + in + let v : Js_cmj_format.t = + Lam_stats_export.export_to_cmj meta effect coerced_input.export_map + (get_leading_case output_prefix) + in + if not @@ !Clflags.dont_write_files then + Js_cmj_format.to_file ~check_exists:(not !Js_config.force_cmj) + (output_prefix ^ Literals.suffix_cmj) + v; + { J.program; side_effect = effect; modules = external_module_ids } -let (//) = Filename.concat -let lambda_as_module - (lambda_output : J.deps_program) - (output_prefix : string) - : unit = - let basename = - Ext_namespace.change_ext_ns_suffix - (Filename.basename - output_prefix) - (if !Js_config.bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) - in - let package_info = Js_packages_state.get_packages_info () in - if Js_packages_info.is_empty package_info && !Js_config.js_stdout then - Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout +let ( // ) = Filename.concat + +let lambda_as_module (lambda_output : J.deps_program) (output_prefix : string) : + unit = + let package_info = Js_current_package_info.get_packages_info () in + if Js_package_info.is_empty package_info && !Js_config.js_stdout then + Js_dump_program.dump_deps_program ~ext:".js" ~output_prefix NodeJS + lambda_output stdout else - Js_packages_info.iter package_info (fun {module_system; path = _path} -> - let output_chan chan = - Js_dump_program.dump_deps_program ~output_prefix - module_system - lambda_output - chan in - if not @@ !Clflags.dont_write_files then + Js_package_info.iter package_info + (fun { module_system; path = _path; extension } -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:(Filename.basename output_prefix) + ~ext:extension + in + let output_chan chan = + Js_dump_program.dump_deps_program ~output_prefix ~ext:extension + module_system lambda_output chan + in + if not @@ !Clflags.dont_write_files then Ext_pervasives.with_file_as_chan #if BS_NATIVE then - (if Filename.is_relative _path then Lazy.force Ext_path.package_dir // _path // basename - (* #913 only generate little-case js file *) - else _path // basename) output_chan ) + ( if Filename.is_relative _path then + Lazy.force Ext_path.package_dir // _path // basename + (* #913 only generate little-case js file *) + else _path // basename ) + output_chan) #else - (Lazy.force Ext_path.package_dir // - _path // - basename - (* #913 only generate little-case js file *) - ) output_chan ) - + ( Lazy.force Ext_path.package_dir + // _path // basename (* #913 only generate little-case js file *) ) + output_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, - includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr} +(* 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, includes {!Pervasives.stdin, Pervasives.stdout, + Pervasives.stderr} - However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name -*) + However, use filename instead of {!Env.current_unit} is more honest, since + node-js module system is coupled with the file name *) diff --git a/jscomp/core/lam_compile_main.mli b/jscomp/core/lam_compile_main.mli index cc06b40cc3..5008b564f9 100644 --- a/jscomp/core/lam_compile_main.mli +++ b/jscomp/core/lam_compile_main.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,32 +17,17 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** BuckleScript entry point in the OCaml compiler *) +val compile : string -> Lambda.lambda -> J.deps_program +(** Compile and register the hook of function to compile a lambda to JS IR + For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name + ()} *) - - - - -(** BuckleScript entry point in the OCaml compiler *) - -(** Compile and register the hook of function to compile a lambda to JS IR - *) - -(** For toplevel, [filename] is [""] which is the same as - {!Env.get_unit_name ()} - *) -val compile : - string -> - Lambda.lambda -> - J.deps_program - -val lambda_as_module : - J.deps_program -> - string -> - unit +val lambda_as_module : J.deps_program -> string -> unit diff --git a/jscomp/core/lam_stats_export.ml b/jscomp/core/lam_stats_export.ml index b8941bda37..707b9174f3 100644 --- a/jscomp/core/lam_stats_export.ml +++ b/jscomp/core/lam_stats_export.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,132 +17,100 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let pp = Format.fprintf - - - - -let pp = Format.fprintf (* we should exclude meaninglist names and do the convert as well *) - -(* let meaningless_names = ["*opt*"; "param";] *) - - +(* let meaningless_names = ["*opt*"; "param";] *) let single_na = Js_cmj_format.single_na -let values_of_export - (meta : Lam_stats.t) - (export_map : Lam.t Map_ident.t) - : Js_cmj_format.cmj_value Map_string.t - = - Ext_list.fold_left meta.exports Map_string.empty - (fun acc x -> - let arity : Js_cmj_format.arity = - match Hash_ident.find_opt meta.ident_tbl x with - | Some (FunctionId {arity ; _}) -> Single arity - | Some (ImmutableBlock(elems)) -> - (* FIXME: field name for dumping*) - Submodule(Ext_array.map elems (fun x -> - match x with - | NA -> Lam_arity.na - | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam) - ) - | Some _ - | None -> - begin match Map_ident.find_opt export_map x with - | Some (Lprim {primitive = Pmakeblock (_,_, Immutable); args }) -> - Submodule (Ext_array.of_list_map args (fun lam -> - Lam_arity_analysis.get_arity meta lam)) - | Some _ - | None -> single_na - end - in - let persistent_closed_lambda = - if not !Js_config.cross_module_inline then None - else match Map_ident.find_opt export_map x with - | Some lambda -> - if Lam_analysis.safe_to_inline lambda - (* when inlning a non function, we have to be very careful, - only truly immutable values can be inlined - *) - then - if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *) - then - if Lam_closure.is_closed lambda (* TODO: seriealize more*) - then Some lambda - else None - else - let lam_size = Lam_analysis.size lambda in - (* TODO: - 1. global need re-assocate when do the beta reduction - 2. [lambda_exports] is not precise - *) - let free_variables = - Lam_closure.free_variables Set_ident.empty Map_ident.empty lambda in - if lam_size < Lam_analysis.small_inline_size && - Map_ident.is_empty free_variables - then - begin - Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name ; - Some lambda - end - else None - else - None - | None -> None in - Map_string.add acc x.name Js_cmj_format.{arity ; persistent_closed_lambda } - ) - -(* ATTENTION: all runtime modules, if it is not hard required, - it should be okay to not reference it -*) -let get_dependent_module_effect - (meta : Lam_stats.t) - (maybe_pure : string option) - (external_ids : Lam_module_ident.t list) = +let values_of_export (meta : Lam_stats.t) (export_map : Lam.t Map_ident.t) : + Js_cmj_format.cmj_value Map_string.t = + Ext_list.fold_left meta.exports Map_string.empty (fun acc x -> + let arity : Js_cmj_format.arity = + match Hash_ident.find_opt meta.ident_tbl x with + | Some (FunctionId { arity; _ }) -> Single arity + | Some (ImmutableBlock elems) -> + (* FIXME: field name for dumping*) + Submodule + (Ext_array.map elems (fun x -> + match x with + | NA -> Lam_arity.na + | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> ( + match Map_ident.find_opt export_map x with + | Some (Lprim { primitive = Pmakeblock (_, _, Immutable); args }) -> + Submodule + (Ext_array.of_list_map args (fun lam -> + Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> single_na ) + in + let persistent_closed_lambda = + if not !Js_config.cross_module_inline then None + else + match Map_ident.find_opt export_map x with + | Some lambda -> + if + Lam_analysis.safe_to_inline lambda + (* when inlning a non function, we have to be very careful, only + truly immutable values can be inlined *) + then + if + Lam_inline_util.should_be_functor x.name lambda + (* can also be submodule *) + then + if Lam_closure.is_closed lambda (* TODO: seriealize more*) + then Some lambda + else None + else + let lam_size = Lam_analysis.size lambda in + (* TODO: 1. global need re-assocate when do the beta reduction + 2. [lambda_exports] is not precise *) + let free_variables = + Lam_closure.free_variables Set_ident.empty Map_ident.empty + lambda + in + if + lam_size < Lam_analysis.small_inline_size + && Map_ident.is_empty free_variables + then ( + Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name; + Some lambda ) + else None + else None + | None -> None + in + Map_string.add acc x.name + Js_cmj_format.{ arity; persistent_closed_lambda }) + + +(* ATTENTION: all runtime modules, if it is not hard required, it should be okay + to not reference it *) +let get_dependent_module_effect (meta : Lam_stats.t) + (maybe_pure : string option) (external_ids : Lam_module_ident.t list) = if maybe_pure = None then - let non_pure_module = - Ext_list.find_first_not external_ids - Lam_compile_env.is_pure_module - in - Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) - else - maybe_pure - - - -(* Note that - [lambda_exports] is - lambda expression to be exported - for the js backend, we compile to js - for the inliner, we try to seriaize it -- - relies on other optimizations to make this happen - {[ - exports.Make = function () {.....} - ]} - TODO: check that we don't do this in browser environment -*) -let export_to_cmj - (meta : Lam_stats.t ) - effect - export_map - cmj_case - : Js_cmj_format.t = - let values = values_of_export meta export_map in - - Js_cmj_format.mk - ~values - ~effect - ~npm_package_path: (Js_packages_state.get_packages_info ()) - ~cmj_case - (* FIXME: make sure [-o] would not change its case - add test for ns/non-ns - *) - - + let non_pure_module = + Ext_list.find_first_not external_ids Lam_compile_env.is_pure_module + in + Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) + else maybe_pure + + +(* Note that [lambda_exports] is lambda expression to be exported for the js + backend, we compile to js for the inliner, we try to seriaize it -- relies on + other optimizations to make this happen {[ exports.Make = function () {.....} + ]} TODO: check that we don't do this in browser environment *) +let export_to_cmj (meta : Lam_stats.t) effect export_map + (leading_case : Ext_namespace.leading_case) : Js_cmj_format.t = + let values = values_of_export meta export_map in + + (* FIXME: make sure [-o] would not change its case *) + (* FIXME: add test for ns/non-ns *) + Js_cmj_format.mk ~values ~effect + ~package_info:(Js_current_package_info.get_packages_info ()) + ~leading_case diff --git a/jscomp/core/lam_stats_export.mli b/jscomp/core/lam_stats_export.mli index 903336d930..f8effbe9c3 100644 --- a/jscomp/core/lam_stats_export.mli +++ b/jscomp/core/lam_stats_export.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,24 +17,17 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val get_dependent_module_effect : + Lam_stats.t -> string option -> Lam_module_ident.t list -> string option - - -val get_dependent_module_effect: - Lam_stats.t -> - string option -> - Lam_module_ident.t list -> - string option - -val export_to_cmj : +val export_to_cmj : Lam_stats.t -> Js_cmj_format.effect -> Lam.t Map_ident.t -> - Js_cmj_format.cmj_case -> + Ext_namespace.leading_case -> Js_cmj_format.t - diff --git a/jscomp/ext/ext_namespace.ml b/jscomp/ext/ext_namespace.ml index 4e40ede64f..d887552fd4 100644 --- a/jscomp/ext/ext_namespace.ml +++ b/jscomp/ext/ext_namespace.ml @@ -1,6 +1,5 @@ - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -18,112 +17,113 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) - -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) - -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - - - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false - - -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) + + +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + + #1933 when removing ns suffix, don't pass the bound of basename + + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext + + +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) + + +type leading_case = Upper | Lower + +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext + + +(** https://docs.npmjs.com/files/package.json + + Some rules: + + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. + + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = if off >= len then () - else + else let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf diff --git a/jscomp/ext/ext_namespace.mli b/jscomp/ext/ext_namespace.mli index 507194ab32..e01d1f0de1 100644 --- a/jscomp/ext/ext_namespace.mli +++ b/jscomp/ext/ext_namespace.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,55 +17,30 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option - -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string diff --git a/jscomp/ext/literals.ml b/jscomp/ext/literals.ml index c89368b9e5..fbce259a67 100644 --- a/jscomp/ext/literals.ml +++ b/jscomp/ext/literals.ml @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,7 +17,7 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -31,7 +31,7 @@ let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -90,8 +90,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -99,19 +99,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -130,6 +135,6 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" -let sourcedirs_meta = ".sourcedirs.json" \ No newline at end of file +let sourcedirs_meta = ".sourcedirs.json" diff --git a/jscomp/ext/literals.mli b/jscomp/ext/literals.mli index 0ceb830b35..79cb6207ba 100644 --- a/jscomp/ext/literals.mli +++ b/jscomp/ext/literals.mli @@ -1,5 +1,5 @@ (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -17,7 +17,7 @@ * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -27,7 +27,7 @@ -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -40,9 +40,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -85,7 +85,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -95,41 +95,45 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string -val sourcedirs_meta : string \ No newline at end of file +val sourcedirs_meta : string diff --git a/jscomp/main/js_main.ml b/jscomp/main/js_main.ml index 6f5902f362..7ec58999b4 100644 --- a/jscomp/main/js_main.ml +++ b/jscomp/main/js_main.ml @@ -10,107 +10,88 @@ (* *) (***********************************************************************) - let process_interface_file ppf name = Js_implementation.interface ppf name (Compenv.output_prefix name) + + let process_implementation_file ppf name = Js_implementation.implementation ppf name (Compenv.output_prefix name) -let setup_reason_context () = +let setup_reason_context () = Js_config.is_reason := true; - Clflags.preprocessor := None ; (* FIX #3988*) - Lazy.force Super_main.setup; + Clflags.preprocessor := None; + (* FIX #3988*) + Lazy.force Super_main.setup; Lazy.force Reason_outcome_printer_main.setup -let reason_pp ~sourcefile = + +let reason_pp ~sourcefile = setup_reason_context (); Ast_reason_pp.pp sourcefile -type valid_input = - | Ml + +type valid_input = + | Ml | Mli | Re | Rei - | Mlast - | Mliast + | Mlast + | Mliast | Reast | Reiast | Mlmap | Cmi -(** This is per-file based, - when [ocamlc] [-c -o another_dir/xx.cmi] - it will return (another_dir/xx) -*) +(** This is per-file based, when [ocamlc] [-c -o another_dir/xx.cmi] it will + return (another_dir/xx) *) - -let process_file ppf sourcefile = - (* This is a better default then "", it will be changed later - The {!Location.input_name} relies on that we write the binary ast - properly - *) - Location.set_input_name sourcefile; - let ext = Ext_filename.get_extension_maybe sourcefile in - let input = - if ext = Literals.suffix_ml then - Ml - else if ext = Literals.suffix_re then - Re - else if ext = !Config.interface_suffix then - Mli - else if ext = Literals.suffix_rei then - Rei - else if ext = Literals.suffix_mlast then - Mlast - else if ext = Literals.suffix_mliast then - Mliast - else if ext = Literals.suffix_reast then - Reast - else if ext = Literals.suffix_reiast then - Reiast - else if ext = Literals.suffix_mlmap then - Mlmap - else if ext = Literals.suffix_cmi then - Cmi - else - raise(Arg.Bad("don't know what to do with " ^ sourcefile)) in - let opref = Compenv.output_prefix sourcefile in - match input with - | Re -> - setup_reason_context (); - let tmpfile = reason_pp ~sourcefile in - Js_implementation.implementation ppf tmpfile opref ; - Ast_reason_pp.clean tmpfile +let process_file ppf sourcefile = + (* This is a better default then "", it will be changed later The + {!Location.input_name} relies on that we write the binary ast properly *) + Location.set_input_name sourcefile; + let ext = Ext_filename.get_extension_maybe sourcefile in + let input = + if ext = Literals.suffix_ml then Ml + else if ext = Literals.suffix_re then Re + else if ext = !Config.interface_suffix then Mli + else if ext = Literals.suffix_rei then Rei + else if ext = Literals.suffix_mlast then Mlast + else if ext = Literals.suffix_mliast then Mliast + else if ext = Literals.suffix_reast then Reast + else if ext = Literals.suffix_reiast then Reiast + else if ext = Literals.suffix_mlmap then Mlmap + else if ext = Literals.suffix_cmi then Cmi + else raise (Arg.Bad ("don't know what to do with " ^ sourcefile)) + in + let opref = Compenv.output_prefix sourcefile in + match input with + | Re -> + setup_reason_context (); + let tmpfile = reason_pp ~sourcefile in + Js_implementation.implementation ppf tmpfile opref; + Ast_reason_pp.clean tmpfile | Rei -> - setup_reason_context (); - let tmpfile = (reason_pp ~sourcefile) in - Js_implementation.interface ppf tmpfile opref ; - Ast_reason_pp.clean tmpfile - | Reiast - -> - setup_reason_context (); - Js_implementation.interface_mliast ppf sourcefile opref - | Reast - -> - setup_reason_context (); - Js_implementation.implementation_mlast ppf sourcefile opref - | Ml -> - Js_implementation.implementation ppf sourcefile opref - | Mli -> - Js_implementation.interface ppf sourcefile opref - | Mliast - -> Js_implementation.interface_mliast ppf sourcefile opref - | Mlast - -> Js_implementation.implementation_mlast ppf sourcefile opref - | Mlmap - -> Js_implementation.implementation_map ppf sourcefile opref - | Cmi - -> - let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in - Printtyp.signature Format.std_formatter cmi_sign ; - Format.pp_print_newline Format.std_formatter () - + setup_reason_context (); + let tmpfile = reason_pp ~sourcefile in + Js_implementation.interface ppf tmpfile opref; + Ast_reason_pp.clean tmpfile + | Reiast -> + setup_reason_context (); + Js_implementation.interface_mliast ppf sourcefile opref + | Reast -> + setup_reason_context (); + Js_implementation.implementation_mlast ppf sourcefile opref + | Ml -> Js_implementation.implementation ppf sourcefile opref + | Mli -> Js_implementation.interface ppf sourcefile opref + | Mliast -> Js_implementation.interface_mliast ppf sourcefile opref + | Mlast -> Js_implementation.implementation_mlast ppf sourcefile opref + | Mlmap -> Js_implementation.implementation_map ppf sourcefile opref + | Cmi -> + let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in + Printtyp.signature Format.std_formatter cmi_sign; + Format.pp_print_newline Format.std_formatter () + let usage = "Usage: bsc \nOptions are:" @@ -118,243 +99,166 @@ let ppf = Format.err_formatter (* Error messages to standard error formatter *) let anonymous filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_file ppf filename;; + Compenv.readenv ppf (Before_compile filename); + process_file ppf filename + + let impl filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_implementation_file ppf filename;; -let intf filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_interface_file ppf filename;; + Compenv.readenv ppf (Before_compile filename); + process_implementation_file ppf filename +let intf filename = + Compenv.readenv ppf (Before_compile filename); + process_interface_file ppf filename + let eval (s : string) ~suffix = - let tmpfile = Filename.temp_file "eval" suffix in - Ext_io.write_file tmpfile s; - anonymous tmpfile; + let tmpfile = Filename.temp_file "eval" suffix in + Ext_io.write_file tmpfile s; + anonymous tmpfile; Ast_reason_pp.clean tmpfile - - -let (//) = Filename.concat +let ( // ) = Filename.concat - - let define_variable s = match Ext_string.split ~keep_empty:true s '=' with - | [key; v] -> - if not @@ Lexer.define_key_value key v then - raise (Arg.Bad ("illegal definition: " ^ s)) + | [ key; v ] -> + if not @@ Lexer.define_key_value key v then + raise (Arg.Bad ("illegal definition: " ^ s)) | _ -> raise (Arg.Bad ("illegal definition: " ^ s)) - + let buckle_script_flags : (string * Arg.spec * string) list = - ("-bs-super-errors", - Arg.Unit - (* needs to be set here instead of, say, setting a - Js_config.better_errors flag; otherwise, when `anonymous` runs, we - don't have time to set the custom printer before it starts outputting - warnings *) - (fun _ -> Lazy.force Super_main.setup) - , - " Better error message combined with other tools " - ) - :: - ("-bs-re-out", - Arg.Unit (fun _ -> Lazy.force Reason_outcome_printer_main.setup), - " Print compiler output in Reason syntax" - ) - :: - ("-bs-jsx", - Arg.Int (fun i -> Js_config.jsx_version := i), - " Set jsx version" - ) - :: - ("-bs-refmt", - Arg.String (fun s -> Js_config.refmt := Some s), - " Set customized refmt path" - ) - - :: - ( - "-bs-gentype", - Arg.String (fun s -> Clflags.bs_gentype := Some s), - " Pass gentype command" - ) - :: - ("-bs-suffix", - Arg.Set Js_config.bs_suffix, - " Set suffix to .bs.js" - ) - :: - ("-bs-no-implicit-include", Arg.Set Clflags.no_implicit_current_dir - , " Don't include current dir implicitly") - :: - ("-bs-read-cmi", Arg.Unit (fun _ -> Clflags.assume_no_mli := Clflags.Mli_exists), - " (internal) Assume mli always exist ") - :: - ("-bs-D", Arg.String define_variable, - " Define conditional variable e.g, -D DEBUG=true" - ) - :: - ("-bs-quiet", Arg.Set Clflags.bs_quiet, - " Quiet mode (no warnings printed)" - ) - :: - ("-bs-list-conditionals", - Arg.Unit (fun () -> Lexer.list_variables Format.err_formatter), - " List existing conditional variables") - :: - ( - "-bs-binary-ast", Arg.Set Js_config.binary_ast, - " Generate binary .mli_ast and ml_ast" - ) - :: - ( - "-bs-simple-binary-ast", Arg.Set Js_config.simple_binary_ast, - " Generate binary .mliast_simple and mlast_simple" - ) - :: - ("-bs-syntax-only", - Arg.Set Js_config.syntax_only, - " only check syntax" - ) - :: - ("-bs-no-bin-annot", Arg.Clear Clflags.binary_annotations, - " disable binary annotations (by default on)") - :: - ("-bs-eval", - Arg.String (fun s -> eval s ~suffix:Literals.suffix_ml), - " (experimental) Set the string to be evaluated in OCaml syntax" - ) - :: - ("-e", - Arg.String (fun s -> eval s ~suffix:Literals.suffix_re), - " (experimental) Set the string to be evaluated in ReasonML syntax" - ) - :: - ( - "-bs-cmi-only", - Arg.Set Js_config.cmi_only, - " Stop after generating cmi file" - ) - :: - ( - "-bs-cmi", - Arg.Set Js_config.force_cmi, - " Not using cached cmi, always generate cmi" - ) - :: - ("-bs-cmj", - Arg.Set Js_config.force_cmj, - " Not using cached cmj, always generate cmj" - ) - :: - ("-bs-g", - Arg.Unit - (fun _ -> Js_config.debug := true; - Lexer.replace_directive_bool "DEBUG" true - ), - " debug mode" - ) - :: - ( - "-bs-sort-imports", - Arg.Set Js_config.sort_imports, - " Sort the imports by lexical order so the output will be more stable (default false)" - ) - :: - ( "-bs-no-sort-imports", - Arg.Clear Js_config.sort_imports, - " No sort (see -bs-sort-imports)" - ) - :: - ("-bs-package-name", - Arg.String Js_packages_state.set_package_name, - " set package name, useful when you want to produce npm packages") - :: - ( "-bs-ns", - Arg.String Js_packages_state.set_package_map, - " set package map, not only set package name but also use it as a namespace" - ) - :: - ("-bs-no-version-header", - Arg.Set Js_config.no_version_header, - " Don't print version header" - ) - :: - ("-bs-package-output", - Arg.String - Js_packages_state.update_npm_package_path, - " set npm-output-path: [opt_module]:path, for example: 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' ") - :: - ("-bs-no-warn-unimplemented-external", - Arg.Set Js_config.no_warn_unimplemented_external, - " disable warnings on unimplmented c externals" - ) - :: - ("-bs-no-builtin-ppx-ml", - Arg.Set Js_config.no_builtin_ppx_ml, - "disable built-in ppx for ml files (internal use)") - :: - ("-bs-no-builtin-ppx-mli", - Arg.Set Js_config.no_builtin_ppx_mli, - "disable built-in ppx for mli files (internal use)") - :: - ("-bs-cross-module-opt", - Arg.Set Js_config.cross_module_inline, - "enable cross module inlining(experimental), default(false)") - :: - ("-bs-diagnose", - Arg.Set Js_config.diagnose, - " More verbose output") - :: - ("-bs-no-check-div-by-zero", - Arg.Clear Js_config.check_div_by_zero, - " unsafe mode, don't check div by zero and mod by zero") - :: - ("-bs-noassertfalse", - Arg.Set Clflags.no_assert_false, - " no code for assert false" - ) - :: - ("-bs-loc", - Arg.Set Clflags.dump_location, - " dont display location with -dtypedtree, -dparsetree" - ) - :: Ocaml_options.mk_impl - (fun file -> Js_config.js_stdout := false; impl file ) - :: Ocaml_options.mk_intf - (fun file -> Js_config.js_stdout := false ; intf file) + ( "-bs-super-errors", + Arg.Unit + (* needs to be set here instead of, say, setting a Js_config.better_errors + flag; otherwise, when `anonymous` runs, we don't have time to set the + custom printer before it starts outputting warnings *) + (fun _ -> Lazy.force Super_main.setup), + " Better error message combined with other tools " ) + :: ( "-bs-re-out", + Arg.Unit (fun _ -> Lazy.force Reason_outcome_printer_main.setup), + " Print compiler output in Reason syntax" ) + :: ( "-bs-jsx", + Arg.Int (fun i -> Js_config.jsx_version := i), + " Set jsx version" ) + :: ( "-bs-refmt", + Arg.String (fun s -> Js_config.refmt := Some s), + " Set customized refmt path" ) + :: ( "-bs-gentype", + Arg.String (fun s -> Clflags.bs_gentype := Some s), + " Pass gentype command" ) + :: ( "-bs-suffix", + Arg.Unit Js_package_info.deprecated_set_bs_extension, + " (DEPRECATED) Set default suffix to .bs.js - use third compoment of \ + -bs-package-output instead" ) + :: ( "-bs-no-implicit-include", + Arg.Set Clflags.no_implicit_current_dir, + " Don't include current dir implicitly" ) + :: ( "-bs-read-cmi", + Arg.Unit (fun _ -> Clflags.assume_no_mli := Clflags.Mli_exists), + " (internal) Assume mli always exist " ) + :: ( "-bs-D", + Arg.String define_variable, + " Define conditional variable e.g, -D DEBUG=true" ) + :: ("-bs-quiet", Arg.Set Clflags.bs_quiet, " Quiet mode (no warnings printed)") + :: ( "-bs-list-conditionals", + Arg.Unit (fun () -> Lexer.list_variables Format.err_formatter), + " List existing conditional variables" ) + :: ( "-bs-binary-ast", + Arg.Set Js_config.binary_ast, + " Generate binary .mli_ast and ml_ast" ) + :: ( "-bs-simple-binary-ast", + Arg.Set Js_config.simple_binary_ast, + " Generate binary .mliast_simple and mlast_simple" ) + :: ("-bs-syntax-only", Arg.Set Js_config.syntax_only, " only check syntax") + :: ( "-bs-no-bin-annot", + Arg.Clear Clflags.binary_annotations, + " disable binary annotations (by default on)" ) + :: ( "-bs-eval", + Arg.String (fun s -> eval s ~suffix:Literals.suffix_ml), + " (experimental) Set the string to be evaluated in OCaml syntax" ) + :: ( "-e", + Arg.String (fun s -> eval s ~suffix:Literals.suffix_re), + " (experimental) Set the string to be evaluated in ReasonML syntax" ) + :: ( "-bs-cmi-only", + Arg.Set Js_config.cmi_only, + " Stop after generating cmi file" ) + :: ( "-bs-cmi", + Arg.Set Js_config.force_cmi, + " Not using cached cmi, always generate cmi" ) + :: ( "-bs-cmj", + Arg.Set Js_config.force_cmj, + " Not using cached cmj, always generate cmj" ) + :: ( "-bs-g", + Arg.Unit + (fun _ -> + Js_config.debug := true; + Lexer.replace_directive_bool "DEBUG" true), + " debug mode" ) + :: ( "-bs-sort-imports", + Arg.Set Js_config.sort_imports, + " Sort the imports by lexical order so the output will be more stable \ + (default false)" ) + :: ( "-bs-no-sort-imports", + Arg.Clear Js_config.sort_imports, + " No sort (see -bs-sort-imports)" ) + :: ( "-bs-package-name", + Arg.String Js_current_package_info.set_package_name, + " set package name, useful when you want to produce npm packages" ) + :: ( "-bs-ns", + Arg.String Js_current_package_info.set_package_map, + " set package map, not only set package name but also use it as a \ + namespace" ) + :: ( "-bs-no-version-header", + Arg.Set Js_config.no_version_header, + " Don't print version header" ) + :: ( "-bs-package-output", + Arg.String Js_current_package_info.append_location_descriptor_of_string, + " set npm-output-path: [opt_module]:path:[ext], for example: 'lib/cjs', \ + 'amdjs:lib/amdjs', 'es6:lib/es6:mjs' " ) + :: ( "-bs-no-warn-unimplemented-external", + Arg.Set Js_config.no_warn_unimplemented_external, + " disable warnings on unimplmented c externals" ) + :: ( "-bs-no-builtin-ppx-ml", + Arg.Set Js_config.no_builtin_ppx_ml, + "disable built-in ppx for ml files (internal use)" ) + :: ( "-bs-no-builtin-ppx-mli", + Arg.Set Js_config.no_builtin_ppx_mli, + "disable built-in ppx for mli files (internal use)" ) + :: ( "-bs-cross-module-opt", + Arg.Set Js_config.cross_module_inline, + "enable cross module inlining(experimental), default(false)" ) + :: ("-bs-diagnose", Arg.Set Js_config.diagnose, " More verbose output") + :: ( "-bs-no-check-div-by-zero", + Arg.Clear Js_config.check_div_by_zero, + " unsafe mode, don't check div by zero and mod by zero" ) + :: ( "-bs-noassertfalse", + Arg.Set Clflags.no_assert_false, + " no code for assert false" ) + :: ( "-bs-loc", + Arg.Set Clflags.dump_location, + " dont display location with -dtypedtree, -dparsetree" ) + :: Ocaml_options.mk_impl (fun file -> + Js_config.js_stdout := false; + impl file) + :: Ocaml_options.mk_intf (fun file -> + Js_config.js_stdout := false; + intf file) :: Ocaml_options.mk__ anonymous :: Ocaml_options.ocaml_options - - - -let _ = - (* ( - print_endline - ("BSB_PROJECT_ROOT :" ^ - match Sys.getenv_opt "BSB_PROJECT_ROOT" with - | None -> "None" - | Some s -> s - )); *) +let _ = + (* ( print_endline ("BSB_PROJECT_ROOT :" ^ match Sys.getenv_opt + "BSB_PROJECT_ROOT" with | None -> "None" | Some s -> s )); *) Bs_conditional_initial.setup_env (); try Compenv.readenv ppf Before_args; - Arg.parse buckle_script_flags anonymous usage - with x -> - begin -#if undefined BS_RELEASE_BUILD then - Ext_obj.bt (); -#end - Location.report_exception ppf x; - exit 2 - end + Arg.parse buckle_script_flags anonymous usage + with x -> + Ext_obj.bt (); + Location.report_exception ppf x; + exit 2 diff --git a/jscomp/main/jsoo_main.ml b/jscomp/main/jsoo_main.ml index b154c57bb1..503dec78fa 100644 --- a/jscomp/main/jsoo_main.ml +++ b/jscomp/main/jsoo_main.ml @@ -22,163 +22,165 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** *) module Js = Jsoo_common.Js -(* - Error: - * { - * row: 12, - * column: 2, //can be undefined - * text: "Missing argument", - * type: "error" // or "warning" or "info" - * } -*) -let () = +(** Error: + + {v + { + row: 12, + column: 2, //can be undefined + text: "Missing argument", + type: "error" // or "warning" or "info" + } + v} *) +let () = Bs_conditional_initial.setup_env (); Clflags.binary_annotations := false -let error_of_exn e = - match Location.error_of_exn e with - | Some (`Ok e) -> Some e - | Some `Already_displayed - | None -> None + +let error_of_exn e = + match Location.error_of_exn e with + | Some (`Ok e) -> Some e + | Some `Already_displayed | None -> None + type react_ppx_version = V2 | V3 -let implementation ~use_super_errors ?(react_ppx_version=V3) prefix impl str : Js.Unsafe.obj = +let implementation ~use_super_errors ?(react_ppx_version = V3) prefix impl str : + Js.Unsafe.obj = let modulename = "Test" in (* let env = !Toploop.toplevel_env in *) (* Compmisc.init_path false; *) (* let modulename = module_of_filename ppf sourcefile outputprefix in *) (* Env.set_unit_name modulename; *) - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in (* Question ?? *) + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + (* Question ?? *) (* let finalenv = ref Env.empty in *) let types_signature = ref [] in - if use_super_errors then begin + if use_super_errors then ( Misc.Color.setup (Some Always); - Lazy.force Super_main.setup ; - end; - + Lazy.force Super_main.setup ); try - let ast = impl - (Lexing.from_string - (if prefix then "[@@@bs.config{no_export}]\n#1 \"repl.ml\"\n" ^ str else str )) in - let ast = match react_ppx_version with - | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast - | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast in - let ast = Bs_builtin_ppx.rewrite_implementation ast in - let typed_tree = - let (a,b,_,signature) = Typemod.type_implementation_more modulename modulename modulename env ast in + let ast = + impl + (Lexing.from_string + ( if prefix then "[@@@bs.config{no_export}]\n#1 \"repl.ml\"\n" ^ str + else str )) + in + let ast = + match react_ppx_version with + | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast + | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast + in + let ast = Bs_builtin_ppx.rewrite_implementation ast in + let typed_tree = + let a, b, _, signature = + Typemod.type_implementation_more modulename modulename modulename env + ast + in (* finalenv := c ; *) types_signature := signature; - (a,b) in - typed_tree - |> Translmod.transl_implementation modulename - |> (* Printlambda.lambda ppf *) (fun - {Lambda.code = lam} - -> - let buffer = Buffer.create 1000 in - let () = Js_dump_program.pp_deps_program - ~output_prefix:"" (* does not matter here *) - NodeJS - (Lam_compile_main.compile "" - lam) - (Ext_pp.from_buffer buffer) in - let v = Buffer.contents buffer in - Js.Unsafe.(obj [| "js_code", inject @@ Js.string v |]) ) - (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) - with - | e -> - begin match error_of_exn e with - | Some error -> - Location.report_error Format.err_formatter error; - Jsoo_common.mk_js_error error.loc error.msg - | None -> - Js.Unsafe.(obj [| - "js_error_msg" , inject @@ Js.string (Printexc.to_string e) - |]) - - end + (a, b) + in + typed_tree |> Translmod.transl_implementation modulename + |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam } -> + let buffer = Buffer.create 1000 in + let () = + Js_dump_program.pp_deps_program (* does not matter here *) + ~output_prefix:"" ~ext:".js" NodeJS + (Lam_compile_main.compile "" lam) + (Ext_pp.from_buffer buffer) + in + let v = Buffer.contents buffer in + Js.Unsafe.(obj [| ("js_code", inject @@ Js.string v) |]) + (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) + with e -> ( + match error_of_exn e with + | Some error -> + Location.report_error Format.err_formatter error; + Jsoo_common.mk_js_error error.loc error.msg + | None -> + let open Js.Unsafe in + obj [| ("js_error_msg", inject @@ Js.string (Printexc.to_string e)) |] ) let compile impl ~use_super_errors ?react_ppx_version = - implementation ~use_super_errors ?react_ppx_version false impl + implementation ~use_super_errors ?react_ppx_version false impl + (** TODO: add `[@@bs.config{no_export}]\n# 1 "repl.ml"`*) let shake_compile impl ~use_super_errors ?react_ppx_version = - implementation ~use_super_errors ?react_ppx_version true impl - + implementation ~use_super_errors ?react_ppx_version true impl let load_module cmi_path cmi_content cmj_name cmj_content = Js.create_file cmi_path cmi_content; Js_cmj_datasets.data_sets := - Map_string.add !Js_cmj_datasets.data_sets - cmj_name (lazy (Js_cmj_format.from_string cmj_content)) - + Map_string.add !Js_cmj_datasets.data_sets cmj_name + (lazy (Js_cmj_format.from_string cmj_content)) -let export (field : string) v = - Js.Unsafe.set (Js.Unsafe.global) field v -;; +let export (field : string) v = Js.Unsafe.set Js.Unsafe.global field v (* To add a directory to the load path *) -let dir_directory d = - Config.load_path := d :: !Config.load_path +let dir_directory d = Config.load_path := d :: !Config.load_path - -let () = - dir_directory "/static/cmis" +let () = dir_directory "/static/cmis" let make_compiler name impl = export name - (Js.Unsafe.(obj - [|"compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:false (Js.to_string code))); - "shake_compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (shake_compile impl ~use_super_errors:false (Js.to_string code))); - "compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true (Js.to_string code))); - "compile_super_errors_ppx_v2", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V2 (Js.to_string code))); - "compile_super_errors_ppx_v3", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V3 (Js.to_string code))); - "shake_compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> (shake_compile impl ~use_super_errors:true (Js.to_string code))); - "version", Js.Unsafe.inject (Js.string (Bs_version.version)); - "load_module", - inject @@ - Js.wrap_meth_callback - (fun _ cmi_path cmi_content cmj_name cmj_content -> - let cmj_bytestring = Js.to_bytestring cmj_content in - (* HACK: force string tag to ASCII (9) to avoid - * UTF-8 encoding *) - Js.Unsafe.set cmj_bytestring "t" 9; - load_module cmi_path cmi_content (Js.to_string cmj_name) cmj_bytestring); - |])) + Js.Unsafe.( + obj + [| + ( "compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:false (Js.to_string code)) ); + ( "shake_compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:false + (Js.to_string code)) ); + ( "compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true (Js.to_string code)) ); + ( "compile_super_errors_ppx_v2", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V2 + (Js.to_string code)) ); + ( "compile_super_errors_ppx_v3", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V3 + (Js.to_string code)) ); + ( "shake_compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:true (Js.to_string code)) + ); + ("version", Js.Unsafe.inject (Js.string Bs_version.version)); + ( "load_module", + inject + @@ Js.wrap_meth_callback + (fun _ cmi_path cmi_content cmj_name cmj_content -> + let cmj_bytestring = Js.to_bytestring cmj_content in + (* HACK: force string tag to ASCII (9) to avoid + * UTF-8 encoding *) + Js.Unsafe.set cmj_bytestring "t" 9; + load_module cmi_path cmi_content (Js.to_string cmj_name) + cmj_bytestring) ); + |]) + + let () = make_compiler "ocaml" Parse.implementation (* local variables: *) -(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *) +(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene + driver.cmo" *) (* end: *) diff --git a/jscomp/main/jsoo_refmt_main.ml b/jscomp/main/jsoo_refmt_main.ml index f695fb0dd0..dcbfd256ae 100644 --- a/jscomp/main/jsoo_refmt_main.ml +++ b/jscomp/main/jsoo_refmt_main.ml @@ -22,169 +22,191 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** -`jsoo_refmt_main` is the JSOO compilation entry point for building BuckleScript + Refmt as one bundle. -This is usually the file you want to build for the full playground experience. -*) +(** `jsoo_refmt_main` is the JSOO compilation entry point for building + BuckleScript + Refmt as one bundle. This is usually the file you want to + build for the full playground experience. *) module Js = Jsoo_common.Js -let () = +let () = Bs_conditional_initial.setup_env (); Clflags.binary_annotations := false -let error_of_exn e = - match Location.error_of_exn e with - | Some (`Ok e) -> Some e - | Some `Already_displayed - | None -> None + +let error_of_exn e = + match Location.error_of_exn e with + | Some (`Ok e) -> Some e + | Some `Already_displayed | None -> None + type react_ppx_version = V2 | V3 -let implementation ?prefix ~use_super_errors ?(react_ppx_version=V3) impl str : Js.Unsafe.obj = +let implementation ?prefix ~use_super_errors ?(react_ppx_version = V3) impl str + : Js.Unsafe.obj = let modulename = "Test" in (* let env = !Toploop.toplevel_env in *) (* Compmisc.init_path false; *) (* let modulename = module_of_filename ppf sourcefile outputprefix in *) (* Env.set_unit_name modulename; *) - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in (* Question ?? *) + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + (* Question ?? *) (* let finalenv = ref Env.empty in *) let types_signature = ref [] in - if use_super_errors then begin + if use_super_errors then ( Misc.Color.setup (Some Always); - Lazy.force Super_main.setup ; - end; - - + Lazy.force Super_main.setup ); try - let code = match prefix with + let code = + match prefix with | None -> str - | Some(prefix) -> prefix ^ str in + | Some prefix -> prefix ^ str + in let ast = impl (Lexing.from_string code) in - let ast = match react_ppx_version with - | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast - | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast in - let ast = Bs_builtin_ppx.rewrite_implementation ast in - let typed_tree = - let (a,b,_,signature) = Typemod.type_implementation_more modulename modulename modulename env ast in + let ast = + match react_ppx_version with + | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast + | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast + in + let ast = Bs_builtin_ppx.rewrite_implementation ast in + let typed_tree = + let a, b, _, signature = + Typemod.type_implementation_more modulename modulename modulename env + ast + in (* finalenv := c ; *) types_signature := signature; - (a,b) in - typed_tree - |> Translmod.transl_implementation modulename - |> (* Printlambda.lambda ppf *) (fun - {Lambda.code = lam} - - -> - let buffer = Buffer.create 1000 in - let () = Js_dump_program.pp_deps_program - ~output_prefix:"" (* does not matter here *) - NodeJS - (Lam_compile_main.compile "" - lam) - (Ext_pp.from_buffer buffer) in - let v = Buffer.contents buffer in - Js.Unsafe.(obj [| "js_code", inject @@ Js.string v |]) ) - (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) - with - | e -> - begin match error_of_exn e with - | Some error -> - Location.report_error Format.err_formatter error; + (a, b) + in + typed_tree |> Translmod.transl_implementation modulename + |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam } -> + let buffer = Buffer.create 1000 in + let () = + Js_dump_program.pp_deps_program (* does not matter here *) + ~output_prefix:"" ~ext:".js" NodeJS + (Lam_compile_main.compile "" lam) + (Ext_pp.from_buffer buffer) + in + let v = Buffer.contents buffer in + Js.Unsafe.(obj [| ("js_code", inject @@ Js.string v) |]) + (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) + with e -> ( + match error_of_exn e with + | Some error -> + Location.report_error Format.err_formatter error; Jsoo_common.mk_js_error error.loc error.msg - | None -> + | None -> ( let msg = Printexc.to_string e in match e with - | Refmt_api.Migrate_parsetree.Def.Migration_error (_,loc) - | Refmt_api.Reason_errors.Reason_error (_,loc) -> - Jsoo_common.mk_js_error loc msg - | _ -> - Js.Unsafe.(obj [| - "js_error_msg" , inject @@ Js.string msg; - "type" , inject @@ Js.string "error" - |]) - end + | Refmt_api.Migrate_parsetree.Def.Migration_error (_, loc) + | Refmt_api.Reason_errors.Reason_error (_, loc) -> + Jsoo_common.mk_js_error loc msg + | _ -> + let open Js.Unsafe in + obj + [| + ("js_error_msg", inject @@ Js.string msg); + ("type", inject @@ Js.string "error"); + |] ) ) let compile ~use_super_errors ?react_ppx_version impl = - implementation ~use_super_errors ?react_ppx_version impl + implementation ~use_super_errors ?react_ppx_version impl + let shake_compile ~prefix ~use_super_errors ?react_ppx_version impl = - implementation ~prefix ~use_super_errors ?react_ppx_version impl + implementation ~prefix ~use_super_errors ?react_ppx_version impl + let load_module cmi_path cmi_content cmj_name cmj_content = Js.create_file cmi_path cmi_content; Js_cmj_datasets.data_sets := - Map_string.add !Js_cmj_datasets.data_sets - cmj_name (lazy (Js_cmj_format.from_string cmj_content)) + Map_string.add !Js_cmj_datasets.data_sets cmj_name + (lazy (Js_cmj_format.from_string cmj_content)) -let export (field : string) v = - Js.Unsafe.set (Js.Unsafe.global) field v -;; + +let export (field : string) v = Js.Unsafe.set Js.Unsafe.global field v (* To add a directory to the load path *) -let dir_directory d = - Config.load_path := d :: !Config.load_path +let dir_directory d = Config.load_path := d :: !Config.load_path -let () = - dir_directory "/static/cmis" +let () = dir_directory "/static/cmis" -module Converter = Refmt_api.Migrate_parsetree.Convert(Refmt_api.Migrate_parsetree.OCaml_404)(Refmt_api.Migrate_parsetree.OCaml_406) +module Converter = + Refmt_api.Migrate_parsetree.Convert + (Refmt_api.Migrate_parsetree.OCaml_404) + (Refmt_api.Migrate_parsetree.OCaml_406) -let reason_parse lexbuf = - Refmt_api.Reason_toolchain.RE.implementation lexbuf |> Converter.copy_structure;; +let reason_parse lexbuf = + Refmt_api.Reason_toolchain.RE.implementation lexbuf + |> Converter.copy_structure -let make_compiler ~name ~prefix impl= + +let make_compiler ~name ~prefix impl = export name - (Js.Unsafe.(obj - [|"compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:false (Js.to_string code))); - "shake_compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (shake_compile impl ~use_super_errors:false ~prefix (Js.to_string code))); - "compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true (Js.to_string code))); - "compile_super_errors_ppx_v2", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V2 (Js.to_string code))); - "compile_super_errors_ppx_v3", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V3 (Js.to_string code))); - "shake_compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> (shake_compile impl ~use_super_errors:true ~prefix (Js.to_string code))); - "version", Js.Unsafe.inject (Js.string (match name with | "reason" -> Refmt_api.version | _ -> Bs_version.version)); - "load_module", - inject @@ - Js.wrap_meth_callback - (fun _ cmi_path cmi_content cmj_name cmj_content -> - let cmj_bytestring = Js.to_bytestring cmj_content in - (* HACK: force string tag to ASCII (9) to avoid - * UTF-8 encoding *) - Js.Unsafe.set cmj_bytestring "t" 9; - load_module cmi_path cmi_content (Js.to_string cmj_name) cmj_bytestring); - |])) - -let () = make_compiler ~name:"ocaml" ~prefix:"[@@@bs.config {no_export}]\n#1 \"repl.ml\"\n" Parse.implementation -let () = make_compiler ~name:"reason" ~prefix:"[@bs.config {no_export: no_export}];\n#1 \"repl.re\";\n" reason_parse + Js.Unsafe.( + obj + [| + ( "compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:false (Js.to_string code)) ); + ( "shake_compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:false ~prefix + (Js.to_string code)) ); + ( "compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true (Js.to_string code)) ); + ( "compile_super_errors_ppx_v2", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V2 + (Js.to_string code)) ); + ( "compile_super_errors_ppx_v3", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V3 + (Js.to_string code)) ); + ( "shake_compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:true ~prefix + (Js.to_string code)) ); + ( "version", + Js.Unsafe.inject + (Js.string + ( match name with + | "reason" -> Refmt_api.version + | _ -> Bs_version.version )) ); + ( "load_module", + inject + @@ Js.wrap_meth_callback + (fun _ cmi_path cmi_content cmj_name cmj_content -> + let cmj_bytestring = Js.to_bytestring cmj_content in + (* HACK: force string tag to ASCII (9) to avoid + * UTF-8 encoding *) + Js.Unsafe.set cmj_bytestring "t" 9; + load_module cmi_path cmi_content (Js.to_string cmj_name) + cmj_bytestring) ); + |]) + + +let () = + make_compiler ~name:"ocaml" + ~prefix:"[@@@bs.config {no_export}]\n#1 \"repl.ml\"\n" Parse.implementation + + +let () = + make_compiler ~name:"reason" + ~prefix:"[@bs.config {no_export: no_export}];\n#1 \"repl.re\";\n" + reason_parse (* local variables: *) -(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *) +(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene + driver.cmo" *) (* end: *) - diff --git a/jscomp/ounit_tests/ounit_string_tests.ml b/jscomp/ounit_tests/ounit_string_tests.ml index e40c7deba0..80fdebd74d 100644 --- a/jscomp/ounit_tests/ounit_string_tests.ml +++ b/jscomp/ounit_tests/ounit_string_tests.ml @@ -1,34 +1,34 @@ let ((>::), (>:::)) = OUnit.((>::),(>:::)) -let (=~) = OUnit.assert_equal ~printer:Ext_obj.dump +let (=~) = OUnit.assert_equal ~printer:Ext_obj.dump -let printer_string = fun x -> x +let printer_string = fun x -> x let string_eq = OUnit.assert_equal ~printer:(fun id -> id) -let suites = - __FILE__ >::: +let suites = + __FILE__ >::: [ __LOC__ >:: begin fun _ -> OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 ) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.rindex_neg "hello" 'h' =~ 0 ; Ext_string.rindex_neg "hello" 'e' =~ 1 ; Ext_string.rindex_neg "hello" 'l' =~ 3 ; Ext_string.rindex_neg "hello" 'l' =~ 3 ; Ext_string.rindex_neg "hello" 'o' =~ 4 ; end; - (* __LOC__ >:: begin - fun _ -> - let nl cur s = Ext_string.extract_until s cur '\n' in + (* __LOC__ >:: begin + fun _ -> + let nl cur s = Ext_string.extract_until s cur '\n' in nl (ref 0) "hello\n" =~ "hello"; nl (ref 0) "\nhell" =~ ""; nl (ref 0) "hello" =~ "hello"; - let cur = ref 0 in - let b = "a\nb\nc\nd" in + let cur = ref 0 in + let b = "a\nb\nc\nd" in nl cur b =~ "a"; nl cur b =~ "b"; nl cur b =~ "c"; @@ -36,7 +36,7 @@ let suites = nl cur b =~ "" ; nl cur b =~ "" ; cur := 0 ; - let b = "a\nb\nc\nd\n" in + let b = "a\nb\nc\nd\n" in nl cur b =~ "a"; nl cur b =~ "b"; nl cur b =~ "c"; @@ -44,20 +44,20 @@ let suites = nl cur b =~ "" ; nl cur b =~ "" ; end ; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> let b = "a\nb\nc\nd\n" in - let a = Ext_string.index_count in + let a = Ext_string.index_count in a b 0 '\n' 1 =~ 1 ; a b 0 '\n' 2 =~ 3; a b 0 '\n' 3 =~ 5; - a b 0 '\n' 4 =~ 7; - a b 0 '\n' 5 =~ -1; + a b 0 '\n' 4 =~ 7; + a b 0 '\n' 5 =~ -1; end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (not (Ext_string.for_all_from "xABc"1 (function 'A' .. 'Z' -> true | _ -> false))); @@ -66,58 +66,58 @@ let suites = (function 'A' .. 'Z' -> true | _ -> false))); OUnit.assert_bool __LOC__ ( (Ext_string.for_all_from "xABC" 1_000 - (function 'A' .. 'Z' -> true | _ -> false))); - end; + (function 'A' .. 'Z' -> true | _ -> false))); + end; - (* __LOC__ >:: begin fun _ -> + (* __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ @@ List.for_all (fun x -> Ext_string.is_valid_source_name x = Good) - ["x.ml"; "x.mli"; "x.re"; "x.rei"; + ["x.ml"; "x.mli"; "x.re"; "x.rei"; "A_x.ml"; "ab.ml"; "a_.ml"; "a__.ml"; "ax.ml"]; OUnit.assert_bool __LOC__ @@ not @@ List.exists (fun x -> Ext_string.is_valid_source_name x = Good) - [".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~"; - "...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei"; + [".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~"; + "...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei"; ".#hello.ml"; ".#hello.rei"; "a-.ml"; "a-b.ml"; "-a-.ml" ; "-.ml" ] end; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_filename.module_name "a/hello.ml" =~ "Hello"; Ext_filename.as_module ~basename:"a.ml" =~ Some {module_name = "A"; case = false}; Ext_filename.as_module ~basename:"Aa.ml" =~ Some {module_name = "Aa"; case = true}; Ext_filename.as_module ~basename:"_Aa.ml" =~ None; Ext_filename.as_module ~basename:"A_a" =~ Some {module_name = "A_a"; case = true}; Ext_filename.as_module ~basename:"" =~ None; - Ext_filename.as_module ~basename:"a/hello.ml" =~ + Ext_filename.as_module ~basename:"a/hello.ml" =~ None end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ @@ List.for_all Ext_namespace.is_valid_npm_package_name ["x"; "@angualr"; "test"; "hi-x"; "hi-"] ; OUnit.assert_bool __LOC__ @@ - List.for_all + List.for_all (fun x -> not (Ext_namespace.is_valid_npm_package_name x)) ["x "; "x'"; "Test"; "hI"] ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.find ~sub:"hello" "xx hello xx" =~ 3 ; Ext_string.rfind ~sub:"hello" "xx hello xx" =~ 3 ; Ext_string.find ~sub:"hello" "xx hello hello xx" =~ 3 ; Ext_string.rfind ~sub:"hello" "xx hello hello xx" =~ 9 ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.non_overlap_count ~sub:"0" "1000,000" =~ 6; Ext_string.non_overlap_count ~sub:"0" "000000" =~ 6; Ext_string.non_overlap_count ~sub:"00" "000000" =~ 3; Ext_string.non_overlap_count ~sub:"00" "00000" =~ 2 end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "abc"); OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "a"); OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "b"); @@ -125,229 +125,229 @@ let suites = OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" ""); OUnit.assert_bool __LOC__ (not @@ Ext_string.contain_substring "abc" "abcc"); end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.trim " \t\n" =~ ""; Ext_string.trim " \t\nb" =~ "b"; Ext_string.trim "b \t\n" =~ "b"; - Ext_string.trim "\t\n b \t\n" =~ "b"; + Ext_string.trim "\t\n b \t\n" =~ "b"; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.starts_with "ab" "a" =~ true; Ext_string.starts_with "ab" "" =~ true; Ext_string.starts_with "abb" "abb" =~ true; Ext_string.starts_with "abb" "abbc" =~ false; end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> string_of_bool x ) in - let k = Ext_string.ends_with in + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> string_of_bool x ) in + let k = Ext_string.ends_with in k "xx.ml" ".ml" =~ true; k "xx.bs.js" ".js" =~ true ; k "xx" ".x" =~false; k "xx" "" =~true - end; - __LOC__ >:: begin fun _ -> + end; + __LOC__ >:: begin fun _ -> Ext_string.ends_with_then_chop "xx.ml" ".ml" =~ Some "xx"; Ext_string.ends_with_then_chop "xx.ml" ".mll" =~ None end; - (* __LOC__ >:: begin fun _ -> + (* __LOC__ >:: begin fun _ -> Ext_string.starts_with_and_number "js_fn_mk_01" ~offset:0 "js_fn_mk_" =~ 1 ; Ext_string.starts_with_and_number "js_fn_run_02" ~offset:0 "js_fn_mk_" =~ -1 ; Ext_string.starts_with_and_number "js_fn_mk_03" ~offset:6 "mk_" =~ 3 ; Ext_string.starts_with_and_number "js_fn_mk_04" ~offset:6 "run_" =~ -1; Ext_string.starts_with_and_number "js_fn_run_04" ~offset:6 "run_" =~ 4; - Ext_string.(starts_with_and_number "js_fn_run_04" ~offset:6 "run_" = 3) =~ false + Ext_string.(starts_with_and_number "js_fn_run_04" ~offset:6 "run_" = 3) =~ false end; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.for_all "____" (function '_' -> true | _ -> false) =~ true; Ext_string.for_all "___-" (function '_' -> true | _ -> false) =~ false; - Ext_string.for_all "" (function '_' -> true | _ -> false) + Ext_string.for_all "" (function '_' -> true | _ -> false) =~ true end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.tail_from "ghsogh" 1 =~ "hsogh"; Ext_string.tail_from "ghsogh" 0 =~ "ghsogh" end; - (* __LOC__ >:: begin fun _ -> - Ext_string.digits_of_str "11_js" ~offset:0 2 =~ 11 + (* __LOC__ >:: begin fun _ -> + Ext_string.digits_of_str "11_js" ~offset:0 2 =~ 11 end; *) - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ - (Ext_string.replace_backward_slash "a:\\b\\d" = + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d" = "a:/b/d" ) ; - OUnit.assert_bool __LOC__ - (Ext_string.replace_backward_slash "a:\\b\\d\\" = + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d\\" = "a:/b/d/" ) ; - OUnit.assert_bool __LOC__ - (Ext_string.replace_slash_backward "a:/b/d/"= - "a:\\b\\d\\" - ) ; - OUnit.assert_bool __LOC__ - (let old = "a:bd" in - Ext_string.replace_backward_slash old == + OUnit.assert_bool __LOC__ + (Ext_string.replace_slash_backward "a:/b/d/"= + "a:\\b\\d\\" + ) ; + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == old ) ; - OUnit.assert_bool __LOC__ - (let old = "a:bd" in - Ext_string.replace_backward_slash old == + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == old ) ; end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash "ahgoh" ); - OUnit.assert_bool __LOC__ - (Ext_string.no_slash "" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ + (Ext_string.no_slash "" ); + OUnit.assert_bool __LOC__ (not (Ext_string.no_slash "ahgoh/" )); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (not (Ext_string.no_slash "/ahgoh" )); - OUnit.assert_bool __LOC__ - (not (Ext_string.no_slash "/ahgoh/" )); + OUnit.assert_bool __LOC__ + (not (Ext_string.no_slash "/ahgoh/" )); end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (Ext_string.compare "" "" = 0); OUnit.assert_bool __LOC__ (Ext_string.compare "0" "0" = 0); OUnit.assert_bool __LOC__ (Ext_string.compare "" "acd" < 0); OUnit.assert_bool __LOC__ (Ext_string.compare "acd" "" > 0); - for i = 0 to 256 do - let a = String.init i (fun _ -> '0') in - let b = String.init i (fun _ -> '0') in + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') in OUnit.assert_bool __LOC__ (Ext_string.compare b a = 0); OUnit.assert_bool __LOC__ (Ext_string.compare a b = 0) done ; - for i = 0 to 256 do - let a = String.init i (fun _ -> '0') in - let b = String.init i (fun _ -> '0') ^ "\000"in + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') ^ "\000"in OUnit.assert_bool __LOC__ (Ext_string.compare a b < 0); OUnit.assert_bool __LOC__ (Ext_string.compare b a > 0) done ; end; - __LOC__ >:: begin fun _ -> - let slow_compare x y = - let x_len = String.length x in - let y_len = String.length y in - if x_len = y_len then - String.compare x y - else - Pervasives.compare x_len y_len in + __LOC__ >:: begin fun _ -> + let slow_compare x y = + let x_len = String.length x in + let y_len = String.length y in + if x_len = y_len then + String.compare x y + else + Pervasives.compare x_len y_len in let same_sign x y = - if x = 0 then y = 0 - else if x < 0 then y < 0 - else y > 0 in + if x = 0 then y = 0 + else if x < 0 then y < 0 + else y > 0 in for i = 0 to 3000 do - let chars = [|'a';'b';'c';'d'|] in - let x = Ounit_data_random.random_string chars 129 in - let y = Ounit_data_random.random_string chars 129 in - let a = Ext_string.compare x y in - let b = slow_compare x y in - if same_sign a b then OUnit.assert_bool __LOC__ true + let chars = [|'a';'b';'c';'d'|] in + let x = Ounit_data_random.random_string chars 129 in + let y = Ounit_data_random.random_string chars 129 in + let a = Ext_string.compare x y in + let b = slow_compare x y in + if same_sign a b then OUnit.assert_bool __LOC__ true else failwith ("incosistent " ^ x ^ " " ^ y ^ " " ^ string_of_int a ^ " " ^ string_of_int b) - done + done end ; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat3 "a0" "a1" "a2") "a0a1a2" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat3 "a0" "a11" "") "a0a11" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat4 "a0" "a1" "a2" "a3") "a0a1a2a3" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat4 "a0" "a11" "" "a33") "a0a11a33" - ); + ); end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter2 "a0" "a1") "a0 a1" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter3 "a0" "a1" "a2") "a0 a1 a2" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter4 "a0" "a1" "a2" "a3") "a0 a1 a2 a3" ); end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "" < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx" < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx/" = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx/g/" = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "/xxx/g/" = 0) end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx" 0 < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx/" 1 = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx/g/" 4 = 5); - OUnit.assert_bool __LOC__ - (Ext_string.no_slash_idx_from "xxx/g/" 3 = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx/g/" 3 = 3); + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "/xxx/g/" 0 = 0) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [||]) Ext_string.empty ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0"|]) "a0" ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"|]) "a0 a1" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2"|]) "a0 a1 a2" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3"|]) "a0 a1 a2 a3" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3";""; "a4"|]) "a0 a1 a2 a3 a4" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"a3";""; "a4"|]) "0 a1 2 a3 a4" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"3";"d"; ""; "e"|]) "0 a1 2 3 d e" - ); + ); end; @@ -355,7 +355,7 @@ let suites = Ext_namespace.namespace_of_package_name "bs-json" =~ "BsJson" end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_namespace.namespace_of_package_name "xx" =~ "Xx" end; @@ -370,43 +370,42 @@ let suites = Ext_namespace.namespace_of_package_name "reason" =~ "Reason"; - Ext_namespace.namespace_of_package_name + Ext_namespace.namespace_of_package_name "@aa/bb" =~"AaBb"; - Ext_namespace.namespace_of_package_name + Ext_namespace.namespace_of_package_name "@A/bb" - =~"ABb" - end; - __LOC__ >:: begin fun _ -> - Ext_namespace.change_ext_ns_suffix "a-b" Literals.suffix_js - =~ "a.js"; - Ext_namespace.change_ext_ns_suffix "a-" Literals.suffix_js - =~ "a.js"; - Ext_namespace.change_ext_ns_suffix "a--" Literals.suffix_js - =~ "a-.js"; - Ext_namespace.change_ext_ns_suffix "AA-b" Literals.suffix_js - =~ "AA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Little_js - =~ "aA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Upper_js - =~ "AA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Upper_bs - =~ "AA.bs.js"; - end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> - match x with + =~"ABb" + end; + __LOC__ >:: begin fun _ -> + Ext_namespace.replace_namespace_with_extension + ~name:"a-b" ~ext:Literals.suffix_js =~ "a.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"a-" ~ext:Literals.suffix_js =~ "a.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"a--" ~ext:Literals.suffix_js =~ "a-.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"AA-b" ~ext:Literals.suffix_js =~ "AA.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"AA-b" ~ext:Literals.suffix_js =~ "AA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_js Lower =~ "aA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_js Upper =~ "AA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_bs_js Upper =~ "AA.bs.js"; + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> + match x with | None -> "" | Some (a,b) -> a ^","^ b - ) in + ) in Ext_namespace.try_split_module_name "Js-X" =~ Some ("X","Js"); Ext_namespace.try_split_module_name "Js_X" =~ None end; __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in + let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in let f = Ext_string.capitalize_ascii in f "x" =~ "X"; f "X" =~ "X"; @@ -417,16 +416,16 @@ let suites = f v =~ "Bc"; v =~ "bc" end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:printer_string in - Ext_filename.chop_all_extensions_maybe "a.bs.js" =~ "a" ; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:printer_string in + Ext_filename.chop_all_extensions_maybe "a.bs.js" =~ "a" ; Ext_filename.chop_all_extensions_maybe "a.js" =~ "a"; Ext_filename.chop_all_extensions_maybe "a" =~ "a"; Ext_filename.chop_all_extensions_maybe "a.x.bs.js" =~ "a" end; (* let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in *) __LOC__ >:: begin fun _ -> - let k = Ext_modulename.js_id_name_of_hint_name in + let k = Ext_modulename.js_id_name_of_hint_name in k "xx" =~ "Xx"; k "react-dom" =~ "ReactDom"; k "a/b/react-dom" =~ "ReactDom"; @@ -440,29 +439,29 @@ let suites = k "c/d/a--b"=~ "AB"; k "c/d/ac--" =~ "Ac" end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.capitalize_sub "ab-Ns.cmi" 2 =~ "Ab"; Ext_string.capitalize_sub "Ab-Ns.cmi" 2 =~ "Ab"; Ext_string.capitalize_sub "Ab-Ns.cmi" 3 =~ "Ab-" end ; __LOC__ >:: begin fun _ -> - OUnit.assert_equal - (String.length (Digest.string "")) + OUnit.assert_equal + (String.length (Digest.string "")) Ext_digest.length end; - __LOC__ >:: begin fun _ -> - let bench = String.concat + __LOC__ >:: begin fun _ -> + let bench = String.concat ";" (Ext_list.init 11 (fun i -> string_of_int i)) in - let buf = Ext_buffer.create 10 in + let buf = Ext_buffer.create 10 in OUnit.assert_bool - __LOC__ (Ext_buffer.not_equal buf bench); - for i = 0 to 9 do + __LOC__ (Ext_buffer.not_equal buf bench); + for i = 0 to 9 do Ext_buffer.add_string buf (string_of_int i); Ext_buffer.add_string buf ";" done ; OUnit.assert_bool - __LOC__ (Ext_buffer.not_equal buf bench); + __LOC__ (Ext_buffer.not_equal buf bench); Ext_buffer.add_string buf "10" ; (* print_endline (Ext_buffer.contents buf); print_endline bench; *) @@ -470,7 +469,7 @@ let suites = __LOC__ (not (Ext_buffer.not_equal buf bench)) end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> string_eq (Ext_filename.new_extension "a.c" ".xx") "a.xx"; string_eq (Ext_filename.new_extension "abb.c" ".xx") "abb.xx"; string_eq (Ext_filename.new_extension ".c" ".xx") ".xx"; @@ -482,43 +481,43 @@ let suites = string_eq (Ext_filename.chop_all_extensions_maybe "abx") "abx"; end; __LOC__ >:: begin fun _ -> - string_eq + string_eq (Ext_filename.module_name "a/b/c.d") "C"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.re") "Xc"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.ml") "Xc" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.mli") "Xc" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.cppo.mli") "Xc.cppo"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.cppo.") "Xc.cppo" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc..") "Xc." ; - string_eq + string_eq (Ext_filename.module_name "a/b/Xc..") "Xc." ; - string_eq + string_eq (Ext_filename.module_name "a/b/.") - "" ; + "" ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.split "" ':' =~ []; Ext_string.split "a:b:" ':' =~ ["a";"b"]; Ext_string.split "a:b:" ':' ~keep_empty:true =~ ["a";"b";""] end; - __LOC__ >:: begin fun _ -> - let cmp0 = Ext_string.compare in - let cmp1 = Map_string.compare_key in - let f a b = + __LOC__ >:: begin fun _ -> + let cmp0 = Ext_string.compare in + let cmp1 = Map_string.compare_key in + let f a b = cmp0 a b =~ cmp1 a b ; cmp0 b a =~ cmp1 b a in diff --git a/lib/4.06.1/bsb.ml b/lib/4.06.1/bsb.ml index 37b49e3bf1..7c59c3a086 100644 --- a/lib/4.06.1/bsb.ml +++ b/lib/4.06.1/bsb.ml @@ -65,7 +65,7 @@ module Bsb_build_schemas = struct #1 "bsb_build_schemas.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -83,7 +83,7 @@ module Bsb_build_schemas * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -141,14 +141,16 @@ let generators = "generators" let command = "command" let edge = "edge" let namespace = "namespace" +let _module = "module" let in_source = "in-source" +let suffix = "suffix" let warnings = "warnings" let number = "number" let error = "error" -let suffix = "suffix" let gentypeconfig = "gentypeconfig" let path = "path" let ignored_dirs = "ignored-dirs" + end module Ext_array : sig #1 "ext_array.mli" @@ -4364,7 +4366,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -4382,7 +4384,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -4392,7 +4394,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -4405,9 +4407,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -4450,7 +4452,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -4460,48 +4462,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -4519,7 +4526,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -4533,7 +4540,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -4592,8 +4599,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -4601,19 +4608,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -4632,9 +4644,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ext_path : sig #1 "ext_path.mli" @@ -5858,147 +5871,459 @@ let () = ) end -module Ext_buffer : sig -#1 "ext_buffer.mli" -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - -(** Extensible buffers. - - This module implements buffers that automatically expand - as necessary. It provides accumulative concatenation of strings - in quasi-linear time (instead of quadratic time when strings are - concatenated pairwise). -*) +module Ext_color : sig +#1 "ext_color.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* BuckleScript customization: customized for efficient digest *) +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White -type t -(** The abstract type of buffers. *) +type style + = FG of color + | BG of color + | Bold + | Dim -val create : int -> t -(** [create n] returns a fresh buffer, initially empty. - The [n] parameter is the initial size of the internal byte sequence - that holds the buffer contents. That byte sequence is automatically - reallocated when more than [n] characters are stored in the buffer, - but shrinks back to [n] characters when [reset] is called. - For best performance, [n] should be of the same order of magnitude - as the number of characters that are expected to be stored in - the buffer (for instance, 80 for a buffer that holds one output - line). Nothing bad will happen if the buffer grows beyond that - limit, however. In doubt, take [n = 16] for instance. - If [n] is not between 1 and {!Sys.max_string_length}, it will - be clipped to that interval. *) +(** Input is the tag for example `@{@}` return escape code *) +val ansi_of_tag : string -> string -val contents : t -> string -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. *) +val reset_lit : string -val length : t -> int -(** Return the number of characters currently contained in the buffer. *) +end = struct +#1 "ext_color.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val is_empty : t -> bool -val clear : t -> unit -(** Empty the buffer. *) -val add_char : t -> char -> unit -(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White -val add_string : t -> string -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) +type style + = FG of color + | BG of color + | Bold + | Dim -val add_bytes : t -> bytes -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. - @since 4.02 *) -val add_substring : t -> string -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in string [s] and appends them at the end of the buffer [b]. *) +let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" -val add_subbytes : t -> bytes -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. - @since 4.02 *) +let code_of_style = function + | FG Black -> "30" + | FG Red -> "31" + | FG Green -> "32" + | FG Yellow -> "33" + | FG Blue -> "34" + | FG Magenta -> "35" + | FG Cyan -> "36" + | FG White -> "37" + + | BG Black -> "40" + | BG Red -> "41" + | BG Green -> "42" + | BG Yellow -> "43" + | BG Blue -> "44" + | BG Magenta -> "45" + | BG Cyan -> "46" + | BG White -> "47" -val add_buffer : t -> t -> unit -(** [add_buffer b1 b2] appends the current contents of buffer [b2] - at the end of buffer [b1]. [b2] is not modified. *) + | Bold -> "1" + | Dim -> "2" -val add_channel : t -> in_channel -> int -> unit -(** [add_channel b ic n] reads exactly [n] character from the - input channel [ic] and stores them at the end of buffer [b]. - Raise [End_of_file] if the channel contains fewer than [n] - characters. *) -val output_buffer : out_channel -> t -> unit -(** [output_buffer oc b] writes the current contents of buffer [b] - on the output channel [oc]. *) -val digest : t -> Digest.t +(** TODO: add more styles later *) +let style_of_tag s = match s with + | "error" -> [Bold; FG Red] + | "warning" -> [Bold; FG Magenta] + | "info" -> [Bold; FG Yellow] + | "dim" -> [Dim] + | "filename" -> [FG Cyan] + | _ -> [] -val not_equal : - t -> - string -> - bool +let ansi_of_tag s = + let l = style_of_tag s in + let s = String.concat ";" (Ext_list.map l code_of_style) in + "\x1b[" ^ s ^ "m" -val add_int_1 : - t -> int -> unit -val add_int_2 : - t -> int -> unit -val add_int_3 : - t -> int -> unit +let reset_lit = "\x1b[0m" -val add_int_4 : - t -> int -> unit -val add_string_char : - t -> - string -> - char -> - unit -val add_char_string : - t -> - char -> - string -> - unit -end = struct -#1 "ext_buffer.ml" -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) -(* Extensible buffers *) -type t = - {mutable buffer : bytes; - mutable position : int; - mutable length : int; +end +module Bsb_log : sig +#1 "bsb_log.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + +val setup : unit -> unit + +type level = + | Debug + | Info + | Warn + | Error + +val log_level : level ref + +type 'a fmt = Format.formatter -> ('a, Format.formatter, unit) format -> 'a + +type 'a log = ('a, Format.formatter, unit) format -> 'a + +val verbose : unit -> unit +val debug : 'a log +val info : 'a log +val warn : 'a log +val error : 'a log + +val info_args : string array -> unit + +end = struct +#1 "bsb_log.ml" +(* Copyright (C) 2017- Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + +let ninja_ansi_forced = lazy + (try Sys.getenv "NINJA_ANSI_FORCED" with + Not_found ->"" + ) +let color_enabled = lazy (Unix.isatty Unix.stdout) + +(* same logic as [ninja.exe] *) +let get_color_enabled () = + let colorful = + match ninja_ansi_forced with + | lazy "1" -> true + | lazy ("0" | "false") -> false + | _ -> + Lazy.force color_enabled in + colorful + + + +let color_functions : Format.formatter_tag_functions = { + mark_open_tag = (fun s -> if get_color_enabled () then Ext_color.ansi_of_tag s else Ext_string.empty) ; + mark_close_tag = (fun _ -> if get_color_enabled () then Ext_color.reset_lit else Ext_string.empty); + print_open_tag = (fun _ -> ()); + print_close_tag = (fun _ -> ()) +} + +let set_color ppf = + Format.pp_set_formatter_tag_functions ppf color_functions + + +let setup () = + begin + Format.pp_set_mark_tags Format.std_formatter true ; + Format.pp_set_mark_tags Format.err_formatter true; + Format.pp_set_formatter_tag_functions + Format.std_formatter color_functions; + Format.pp_set_formatter_tag_functions + Format.err_formatter color_functions + end + +type level = + | Debug + | Info + | Warn + | Error + +let int_of_level (x : level) = + match x with + | Debug -> 0 + | Info -> 1 + | Warn -> 2 + | Error -> 3 + +let log_level = ref Warn + +let verbose () = + log_level := Debug +let dfprintf level fmt = + if int_of_level level >= int_of_level !log_level then + Format.fprintf fmt + else Format.ifprintf fmt + +type 'a fmt = + Format.formatter -> ('a, Format.formatter, unit) format -> 'a +type 'a log = + ('a, Format.formatter, unit) format -> 'a + +let debug fmt = dfprintf Debug Format.std_formatter fmt +let info fmt = dfprintf Info Format.std_formatter fmt +let warn fmt = dfprintf Warn Format.err_formatter fmt +let error fmt = dfprintf Error Format.err_formatter fmt + + +let info_args (args : string array) = + if int_of_level Info >= int_of_level !log_level then + begin + for i = 0 to Array.length args - 1 do + Format.pp_print_string Format.std_formatter (Array.unsafe_get args i) ; + Format.pp_print_string Format.std_formatter Ext_string.single_space; + done ; + Format.pp_print_newline Format.std_formatter () + end + else () + + +end +module Ext_buffer : sig +#1 "ext_buffer.mli" +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) + +(** Extensible buffers. + + This module implements buffers that automatically expand + as necessary. It provides accumulative concatenation of strings + in quasi-linear time (instead of quadratic time when strings are + concatenated pairwise). +*) + +(* BuckleScript customization: customized for efficient digest *) + +type t +(** The abstract type of buffers. *) + +val create : int -> t +(** [create n] returns a fresh buffer, initially empty. + The [n] parameter is the initial size of the internal byte sequence + that holds the buffer contents. That byte sequence is automatically + reallocated when more than [n] characters are stored in the buffer, + but shrinks back to [n] characters when [reset] is called. + For best performance, [n] should be of the same order of magnitude + as the number of characters that are expected to be stored in + the buffer (for instance, 80 for a buffer that holds one output + line). Nothing bad will happen if the buffer grows beyond that + limit, however. In doubt, take [n = 16] for instance. + If [n] is not between 1 and {!Sys.max_string_length}, it will + be clipped to that interval. *) + +val contents : t -> string +(** Return a copy of the current contents of the buffer. + The buffer itself is unchanged. *) + +val length : t -> int +(** Return the number of characters currently contained in the buffer. *) + +val is_empty : t -> bool + +val clear : t -> unit +(** Empty the buffer. *) + + +val add_char : t -> char -> unit +(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) + +val add_string : t -> string -> unit +(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) + +val add_bytes : t -> bytes -> unit +(** [add_string b s] appends the string [s] at the end of the buffer [b]. + @since 4.02 *) + +val add_substring : t -> string -> int -> int -> unit +(** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in string [s] and appends them at the end of the buffer [b]. *) + +val add_subbytes : t -> bytes -> int -> int -> unit +(** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. + @since 4.02 *) + +val add_buffer : t -> t -> unit +(** [add_buffer b1 b2] appends the current contents of buffer [b2] + at the end of buffer [b1]. [b2] is not modified. *) + +val add_channel : t -> in_channel -> int -> unit +(** [add_channel b ic n] reads exactly [n] character from the + input channel [ic] and stores them at the end of buffer [b]. + Raise [End_of_file] if the channel contains fewer than [n] + characters. *) + +val output_buffer : out_channel -> t -> unit +(** [output_buffer oc b] writes the current contents of buffer [b] + on the output channel [oc]. *) + +val digest : t -> Digest.t + +val not_equal : + t -> + string -> + bool + +val add_int_1 : + t -> int -> unit + +val add_int_2 : + t -> int -> unit + +val add_int_3 : + t -> int -> unit + +val add_int_4 : + t -> int -> unit + +val add_string_char : + t -> + string -> + char -> + unit + +val add_char_string : + t -> + char -> + string -> + unit +end = struct +#1 "ext_buffer.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Extensible buffers *) + +type t = + {mutable buffer : bytes; + mutable position : int; + mutable length : int; initial_buffer : bytes} let create n = @@ -6461,7 +6786,7 @@ end module Ext_namespace : sig #1 "ext_namespace.mli" (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -6479,64 +6804,38 @@ module Ext_namespace : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option - +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string end = struct #1 "ext_namespace.ml" - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -6554,396 +6853,120 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + #1933 when removing ns suffix, don't pass the bound of basename - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = - if off >= len then () - else - let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf - -end -module Bsb_package_specs : sig -#1 "bsb_package_specs.mli" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t - - -val default_package_specs : t - -val from_json: - Ext_json_types.t -> t - -val get_list_of_output_js : - t -> bool -> string -> string list - -(** - Sample output: {[ -bs-package-output commonjs:lib/js/jscomp/test]} -*) -val package_flag_of_package_specs : - t -> string -> string - -val list_dirs_by : - t -> - (string -> unit) -> - unit -end = struct -#1 "bsb_package_specs.ml" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -let (//) = Ext_path.combine - +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) -(* TODO: sync up with {!Js_packages_info.module_system} *) -type format = - | NodeJS | Es6 | Es6_global - -type spec = { - format : format; - in_source : bool -} - -module Spec_set = Set.Make( struct type t = spec - let compare = Pervasives.compare - end) - -type t = Spec_set.t - - -let bad_module_format_message_exn ~loc format = - Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s or %s" - format - Literals.commonjs - Literals.es6 - Literals.es6_global - -let supported_format (x : string) loc = - if x = Literals.commonjs then NodeJS - else if x = Literals.es6 then Es6 - else if x = Literals.es6_global then Es6_global - else bad_module_format_message_exn ~loc x - -let string_of_format (x : format) = - match x with - | NodeJS -> Literals.commonjs - | Es6 -> Literals.es6 - | Es6_global -> Literals.es6_global - -let prefix_of_format (x : format) = - (match x with - | NodeJS -> Bsb_config.lib_js - | Es6 -> Bsb_config.lib_es6 - | Es6_global -> Bsb_config.lib_es6_global ) - -let rec from_array (arr : Ext_json_types.t array) : Spec_set.t = - let spec = ref Spec_set.empty in - let has_in_source = ref false in - Ext_array.iter arr (fun x -> - let result = from_json_single x in - if result.in_source then - ( - if not !has_in_source then - has_in_source:= true - else - Bsb_exception.errorf - ~loc:(Ext_json.loc_of x) - "package-specs: we've detected two module formats that are both configured to be in-source." - ); - spec := Spec_set.add result !spec - ); - !spec - -(* TODO: FIXME: better API without mutating *) -and from_json_single (x : Ext_json_types.t) : spec = - match x with - | Str {str = format; loc } -> - {format = supported_format format loc ; in_source = false } - | Obj {map; loc} -> - begin match Map_string.find_exn map "module" with - | Str {str = format} -> - let in_source = - match Map_string.find_opt map Bsb_build_schemas.in_source with - | Some (True _) -> true - | Some _ - | None -> false - in - {format = supported_format format loc ; in_source } - | Arr _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, `module` field should be a string, not an array. If you want to pass multiple module specs, try turning package-specs into an array of objects (or strings) instead." - | _ -> - Bsb_exception.errorf ~loc - "package-specs: the `module` field of the configuration object should be a string." - | exception _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, the `module` field is mandatory." - end - | _ -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x) - "package-specs: we expect either a string or an object." - -let from_json (x : Ext_json_types.t) : Spec_set.t = - match x with - | Arr {content ; _} -> from_array content - | _ -> Spec_set.singleton (from_json_single x ) - - -let bs_package_output = "-bs-package-output" - -(** Assume input is valid - {[ -bs-package-output commonjs:lib/js/jscomp/test ]} -*) -let package_flag ({format; in_source } : spec) dir = - Ext_string.inter2 - bs_package_output - (Ext_string.concat3 - (string_of_format format) - Ext_string.single_colon - (if in_source then dir else - prefix_of_format format // dir)) - -let package_flag_of_package_specs (package_specs : t) - (dirname : string ) : string = - Spec_set.fold (fun format acc -> - Ext_string.inter2 acc (package_flag format dirname ) - ) package_specs Ext_string.empty - -let default_package_specs = - Spec_set.singleton - { format = NodeJS ; in_source = false } - - - -(** - [get_list_of_output_js specs "src/hi/hello"] - -*) -let get_list_of_output_js - (package_specs : Spec_set.t) - (bs_suffix : bool) - (output_file_sans_extension : string) - = - Spec_set.fold - (fun (spec : spec) acc -> - let basename = Ext_namespace.change_ext_ns_suffix - output_file_sans_extension - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) - in - (Bsb_config.proj_rel @@ (if spec.in_source then basename - else prefix_of_format spec.format // basename)) - :: acc - ) package_specs [] - - -let list_dirs_by - (package_specs : Spec_set.t) - (f : string -> unit) - = - Spec_set.iter (fun (spec : spec) -> - if not spec.in_source then - f (prefix_of_format spec.format) - ) package_specs -end -module Bsc_warnings -= struct -#1 "bsc_warnings.ml" -(* Copyright (C) 2020- Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 +type leading_case = Upper | Lower - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext +(** https://docs.npmjs.com/files/package.json -(** - See the meanings of the warning codes here: https://caml.inria.fr/pub/docs/manual-ocaml/comp.html#sec281 + Some rules: - - 30 Two labels or constructors of the same name are defined in two mutually recursive types. - - 40 Constructor or label name used out of scope. + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. - - 6 Label omitted in function application. - - 7 Method overridden. - - 9 Missing fields in a record pattern. (*Not always desired, in some cases need [@@@warning "+9"] *) - - 27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn’t start with an underscore (_) character. - - 29 Unescaped end-of-line in a string constant (non-portable code). - - 32 .. 39 Unused blabla - - 44 Open statement shadows an already defined identifier. - - 45 Open statement shadows an already defined label or constructor. - - 48 Implicit elimination of optional arguments. https://caml.inria.fr/mantis/view.php?id=6352 - - 101 (bsb-specific) unsafe polymorphic comparison. -*) -let defaults_w = "-30-40+6+7+27+32..39+44+45+101" -let defaults_warn_error = "-a+5+101";; + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = + if off >= len then () + else + let ch = String.unsafe_get s off in + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end -module Bsb_warning : sig -#1 "bsb_warning.mli" +module Bsb_package_specs : sig +#1 "bsb_package_specs.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -6968,28 +6991,25 @@ module Bsb_warning : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type t +val default_package_specs : ?deprecated_bs_suffix:bool -> unit -> t +val from_json : ?deprecated_bs_suffix:bool -> Ext_json_types.t -> t -type t - -(** Extra work is need to make merlin happy *) -val to_merlin_string : t -> string +val get_list_of_output_js : t -> string -> string list +val extract_in_source_bs_suffixes : t -> string list +val flags_of_package_specs : t -> string -> string +(** Sample output: -val from_map : Ext_json_types.t Map_string.t -> t + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) -(** [to_bsb_string not_dev warning] -*) -val to_bsb_string : - toplevel:bool -> - t -> - string +val list_dirs_by : t -> (string -> unit) -> unit -val use_default : t end = struct -#1 "bsb_warning.ml" +#1 "bsb_package_specs.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -7014,152 +7034,246 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let ( // ) = Ext_path.combine -type warning_error = - | Warn_error_false - (* default [false] to make our changes non-intrusive *) - | Warn_error_true - | Warn_error_number of string +(* TODO: sync up with {!Js_package_info.module_system} *) +type format = NodeJS | Es6 | Es6_global -type t0 = { - number : string option; - error : warning_error -} +type spec = { format : format; in_source : bool; suffix : string } -type nonrec t = t0 option +module Spec_set = Set.Make (struct + type t = spec + let compare = Pervasives.compare +end) -let use_default = None +type t = Spec_set.t -let prepare_warning_concat ~(beg : bool) s = - let s = Ext_string.trim s in - if s = "" then s - else - match s.[0] with - | '0' .. '9' -> if beg then "-w +" ^ s else "+" ^ s - | 'a' .. 'z' -> - if beg then "-w " ^ s else "+" ^ s - | _ -> - if beg then "-w " ^ s else s +let bad_module_format_message_exn ~loc format = + Bsb_exception.errorf ~loc + "package-specs: `%s` isn't a valid output module format. It has to be one \ + of: %s, %s or %s" + format Literals.commonjs Literals.es6 Literals.es6_global -let to_merlin_string x = - "-w " ^ Bsc_warnings.defaults_w - ^ - (match x with - | Some {number =None} - | None -> Ext_string.empty - | Some {number = Some x} -> - prepare_warning_concat ~beg:false x ) +let supported_format (x : string) loc = + if x = Literals.commonjs then NodeJS + else if x = Literals.es6 then Es6 + else if x = Literals.es6_global then Es6_global + else bad_module_format_message_exn ~loc x - -let from_map (m : Ext_json_types.t Map_string.t) = - let number_opt = Map_string.find_opt m Bsb_build_schemas.number in - let error_opt = Map_string.find_opt m Bsb_build_schemas.error in - match number_opt, error_opt with - | None, None -> None - | _, _ -> - let error = - match error_opt with - | Some (True _) -> Warn_error_true - | Some (False _) -> Warn_error_false - | Some (Str {str ; }) - -> Warn_error_number str - | Some x -> Bsb_exception.config_error x "expect true/false or string" - | None -> Warn_error_false - (** To make it less intrusive : warning error has to be enabled*) - in - let number = - match number_opt with - | Some (Str { str = number}) -> Some number - | None -> None - | Some x -> Bsb_exception.config_error x "expect a string" - in - Some {number; error } -let to_bsb_string ~toplevel warning = - match warning with - | None -> Ext_string.empty - | Some warning -> - (match warning.number with - | None -> - Ext_string.empty - | Some x -> - prepare_warning_concat ~beg:true x - ) ^ - if toplevel then - match warning.error with - | Warn_error_true -> - " -warn-error A" - | Warn_error_number y -> - " -warn-error " ^ y - | Warn_error_false -> - Ext_string.empty - else Ext_string.empty +let string_of_format (x : format) = + match x with + | NodeJS -> Literals.commonjs + | Es6 -> Literals.es6 + | Es6_global -> Literals.es6_global -end -module Bs_hash_stubs -= struct -#1 "bs_hash_stubs.ml" +let prefix_of_format (x : format) = + match x with + | NodeJS -> Bsb_config.lib_js + | Es6 -> Bsb_config.lib_es6 + | Es6_global -> Bsb_config.lib_es6_global + + +let deprecated_bs_suffix_message_warn () = + Bsb_log.warn + "@{DEPRECATED@}: @[top-level 'suffix' field is deprecated;@ \ + please lower your extension-configuration into@ 'package-specs'.@]@." + + +let bad_suffix_message_warn suffix = + let open Literals in + Bsb_log.warn + "@{UNSUPPORTED@}: @[package-specs: extension `%s` is \ + unsupported;@ consider one of: %s, %s, %s; %s, %s,@ or %s.@]@." + suffix suffix_js suffix_mjs suffix_cjs suffix_bs_js suffix_bs_mjs + suffix_bs_cjs + + +let supported_suffix (x : string) = + if + not + (List.mem x + Literals. + [ + suffix_js; + suffix_mjs; + suffix_cjs; + suffix_bs_js; + suffix_bs_mjs; + suffix_bs_cjs; + ]) + then bad_suffix_message_warn x; + x -external hash_string : string -> int = "caml_bs_hash_string" [@@noalloc];; +let default_suffix ~deprecated_bs_suffix _format _in_source = + (* match (format, in_source) with *) + (* | NodeJS, false -> Literals.suffix_js *) + (* | NodeJS, true -> Literals.suffix_bs_js *) + (* | _, false -> Literals.suffix_mjs *) + (* | _, true -> Literals.suffix_bs_mjs *) -external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" [@@noalloc];; + (* TODO: In the absence of direction to the contrary, the suffix should + eventually depend on [format] and [in_source]. For now, for + backwards-compatibility, I'm hardcoding. *) + if deprecated_bs_suffix then Literals.suffix_bs_js else Literals.suffix_js -external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" [@@noalloc];; -external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" [@@noalloc];; +module SS = Set.Make (String) -external hash_small_int : int -> int = "caml_bs_hash_small_int" [@@noalloc];; +let supported_bs_suffixes = + Literals.[ suffix_bs_js; suffix_bs_mjs; suffix_bs_cjs ] -external hash_int : int -> int = "caml_bs_hash_int" [@@noalloc];; -external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; +(** Produces a [list] of supported, bs-prefixed file-suffixes used in + [in-source] package-specs. *) +let extract_in_source_bs_suffixes (package_specs : Spec_set.t) = + let f spec suffixes = + if spec.in_source && List.mem spec.suffix supported_bs_suffixes then + SS.add spec.suffix suffixes + else suffixes + in + let suffixes = Spec_set.fold f package_specs SS.empty in + SS.elements suffixes -external - int_unsafe_blit : - int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; - +let rec from_array ~deprecated_bs_suffix (arr : Ext_json_types.t array) : + Spec_set.t = + let specs = ref Spec_set.empty in + Ext_array.iter arr (fun x -> + let spec = from_json_single ~deprecated_bs_suffix x in + if + Spec_set.exists + (fun o -> + spec.in_source == o.in_source && String.equal spec.suffix o.suffix) + !specs + then + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: two conflicting module formats with the extension \ + `%s` are both configured to be in-source." + spec.suffix + else specs := Spec_set.add spec !specs); + !specs + + +(* FIXME: better API without mutating *) +and from_json_single ~deprecated_bs_suffix (x : Ext_json_types.t) : spec = + match x with + | Str { str = format; loc } -> + let format = supported_format format loc in + { + format; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix format false; + } + | Obj { map; loc } -> ( + match Map_string.find_exn map Bsb_build_schemas._module with + | Str { str = format } -> + let format = supported_format format loc in + let in_source = + match Map_string.find_opt map Bsb_build_schemas.in_source with + | Some (True _) -> true + | Some _ | None -> false + in + let suffix = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | Some (Str { str = suffix; loc }) -> supported_suffix suffix + | Some _ -> + Bsb_exception.errorf ~loc + "package-specs: the `suffix` field of the configuration \ + object must be absent, or a string." + | None -> default_suffix ~deprecated_bs_suffix format in_source + in + { format; in_source; suffix } + | Arr _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, `module` \ + field should be a string, not an array. If you want to pass \ + multiple module specs, try turning package-specs into an array of \ + objects (or strings) instead." + | _ -> + Bsb_exception.errorf ~loc + "package-specs: the `module` field of the configuration object \ + should be a string." + | exception _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, the `module` \ + field is mandatory." ) + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: we expect either a string or an object." -end -module Ext_util : sig -#1 "ext_util.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let from_json ?(deprecated_bs_suffix = false) (x : Ext_json_types.t) : + Spec_set.t = + if deprecated_bs_suffix then deprecated_bs_suffix_message_warn (); + match x with + | Arr { content; _ } -> from_array ~deprecated_bs_suffix content + | _ -> Spec_set.singleton (from_json_single ~deprecated_bs_suffix x) - -val power_2_above : int -> int -> int +let bs_package_output = "-bs-package-output" -val stats_to_string : Hashtbl.statistics -> string -end = struct -#1 "ext_util.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +(** Assume input is valid + + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) +let package_flag ({ format; in_source; suffix } : spec) dir = + Ext_string.inter2 bs_package_output + (Ext_string.concat5 (string_of_format format) Ext_string.single_colon + (if in_source then dir else prefix_of_format format // dir) + Ext_string.single_colon suffix) + + +let flags_of_package_specs (package_specs : t) (dirname : string) : string = + Spec_set.fold + (fun format acc -> Ext_string.inter2 acc (package_flag format dirname)) + package_specs Ext_string.empty + + +let default_package_specs ?deprecated_bs_suffix () = + let deprecated_bs_suffix = match deprecated_bs_suffix with + | Some x -> deprecated_bs_suffix_message_warn (); x + | None -> false + in + Spec_set.singleton + { + format = NodeJS; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix NodeJS false; + } + + +(** [get_list_of_output_js specs true "src/hi/hello"] *) +let get_list_of_output_js (package_specs : Spec_set.t) + (output_file_sans_extension : string) = + Spec_set.fold + (fun spec acc -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:output_file_sans_extension ~ext:spec.suffix + in + ( Bsb_config.proj_rel + @@ + if spec.in_source then basename + else prefix_of_format spec.format // basename ) + :: acc) + package_specs [] + + +let list_dirs_by (package_specs : Spec_set.t) (f : string -> unit) = + Spec_set.iter + (fun (spec : spec) -> + if not spec.in_source then f (prefix_of_format spec.format)) + package_specs + +end +module Bsc_warnings += struct +#1 "bsc_warnings.ml" +(* Copyright (C) 2020- Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7176,37 +7290,39 @@ end = struct * This program 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 Lesser General Public License for more details. - * + + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + (** - {[ - (power_2_above 16 63 = 64) - (power_2_above 16 76 = 128) - ]} -*) -let rec power_2_above x n = - if x >= n then x - else if x * 2 > Sys.max_array_length then x - else power_2_above (x * 2) n + See the meanings of the warning codes here: https://caml.inria.fr/pub/docs/manual-ocaml/comp.html#sec281 + - 30 Two labels or constructors of the same name are defined in two mutually recursive types. + - 40 Constructor or label name used out of scope. -let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = - Printf.sprintf - "bindings: %d,buckets: %d, longest: %d, hist:[%s]" - num_bindings - num_buckets - max_bucket_length - (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) -end -module Hash_set_gen -= struct -#1 "hash_set_gen.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + - 6 Label omitted in function application. + - 7 Method overridden. + - 9 Missing fields in a record pattern. (*Not always desired, in some cases need [@@@warning "+9"] *) + - 27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn’t start with an underscore (_) character. + - 29 Unescaped end-of-line in a string constant (non-portable code). + - 32 .. 39 Unused blabla + - 44 Open statement shadows an already defined identifier. + - 45 Open statement shadows an already defined label or constructor. + - 48 Implicit elimination of optional arguments. https://caml.inria.fr/mantis/view.php?id=6352 + - 101 (bsb-specific) unsafe polymorphic comparison. +*) +let defaults_w = "-30-40+6+7+27+32..39+44+45+101" +let defaults_warn_error = "-a+5+101";; + +end +module Bsb_warning : sig +#1 "bsb_warning.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7224,173 +7340,35 @@ module Hash_set_gen * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. *) - -type 'a bucket = - | Empty - | Cons of { - mutable key : 'a ; - mutable next : 'a bucket - } - -type 'a t = - { mutable size: int; (* number of entries *) - mutable data: 'a bucket array; (* the buckets *) - initial_size: int; (* initial array size *) - } - - - - -let create initial_size = - let s = Ext_util.power_2_above 16 initial_size in - { initial_size = s; size = 0; data = Array.make s Empty } - -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - Array.unsafe_set h.data i Empty - done - -let reset h = - h.size <- 0; - h.data <- Array.make h.initial_size Empty - -let length h = h.size - -let resize indexfun h = - let odata = h.data in - let osize = Array.length odata in - let nsize = osize * 2 in - if nsize < Sys.max_array_length then begin - let ndata = Array.make nsize Empty in - let ndata_tail = Array.make nsize Empty in - h.data <- ndata; (* so that indexfun sees the new bucket count *) - let rec insert_bucket = function - Empty -> () - | Cons {key; next} as cell -> - let nidx = indexfun h key in - begin match Array.unsafe_get ndata_tail nidx with - | Empty -> - Array.unsafe_set ndata nidx cell - | Cons tail -> - tail.next <- cell - end; - Array.unsafe_set ndata_tail nidx cell; - insert_bucket next - in - for i = 0 to osize - 1 do - insert_bucket (Array.unsafe_get odata i) - done; - for i = 0 to nsize - 1 do - match Array.unsafe_get ndata_tail i with - | Empty -> () - | Cons tail -> tail.next <- Empty - done - end - -let iter h f = - let rec do_bucket = function - | Empty -> - () - | Cons l -> - f l.key ; do_bucket l.next in - let d = h.data in - for i = 0 to Array.length d - 1 do - do_bucket (Array.unsafe_get d i) - done - -let fold h init f = - let rec do_bucket b accu = - match b with - Empty -> - accu - | Cons l -> - do_bucket l.next (f l.key accu) in - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket (Array.unsafe_get d i) !accu - done; - !accu - - -let elements set = - fold set [] List.cons - - -let rec small_bucket_mem eq key lst = - match lst with - | Empty -> false - | Cons lst -> - eq key lst.key || - match lst.next with - | Empty -> false - | Cons lst -> - eq key lst.key || - match lst.next with - | Empty -> false - | Cons lst -> - eq key lst.key || - small_bucket_mem eq key lst.next +type t -let rec remove_bucket - (h : _ t) (i : int) - key - ~(prec : _ bucket) - (buck : _ bucket) - eq_key = - match buck with - | Empty -> - () - | Cons {key=k; next } -> - if eq_key k key - then begin - h.size <- h.size - 1; - match prec with - | Empty -> Array.unsafe_set h.data i next - | Cons c -> c.next <- next - end - else remove_bucket h i key ~prec:buck next eq_key +(** Extra work is need to make merlin happy *) +val to_merlin_string : t -> string -module type S = -sig - type key - type t - val create: int -> t - val clear : t -> unit - val reset : t -> unit - (* val copy: t -> t *) - val remove: t -> key -> unit - val add : t -> key -> unit - val of_array : key array -> t - val check_add : t -> key -> bool - val mem : t -> key -> bool - val iter: t -> (key -> unit) -> unit - val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b - val length: t -> int - (* val stats: t -> Hashtbl.statistics *) - val elements : t -> key list -end +val from_map : Ext_json_types.t Map_string.t -> t +(** [to_bsb_string not_dev warning] +*) +val to_bsb_string : + toplevel:bool -> + t -> + string -end -module Hash_set_string : sig -#1 "hash_set_string.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +val use_default : t +end = struct +#1 "bsb_warning.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7408,113 +7386,125 @@ module Hash_set_string : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -include Hash_set_gen.S with type key = string +type warning_error = + | Warn_error_false + (* default [false] to make our changes non-intrusive *) + | Warn_error_true + | Warn_error_number of string + +type t0 = { + number : string option; + error : warning_error +} + +type nonrec t = t0 option + +let use_default = None + +let prepare_warning_concat ~(beg : bool) s = + let s = Ext_string.trim s in + if s = "" then s + else + match s.[0] with + | '0' .. '9' -> if beg then "-w +" ^ s else "+" ^ s + | 'a' .. 'z' -> + if beg then "-w " ^ s else "+" ^ s + | _ -> + if beg then "-w " ^ s else s + +let to_merlin_string x = + "-w " ^ Bsc_warnings.defaults_w + ^ + (match x with + | Some {number =None} + | None -> Ext_string.empty + | Some {number = Some x} -> + prepare_warning_concat ~beg:false x ) + + + +let from_map (m : Ext_json_types.t Map_string.t) = + let number_opt = Map_string.find_opt m Bsb_build_schemas.number in + let error_opt = Map_string.find_opt m Bsb_build_schemas.error in + match number_opt, error_opt with + | None, None -> None + | _, _ -> + let error = + match error_opt with + | Some (True _) -> Warn_error_true + | Some (False _) -> Warn_error_false + | Some (Str {str ; }) + -> Warn_error_number str + | Some x -> Bsb_exception.config_error x "expect true/false or string" + | None -> Warn_error_false + (** To make it less intrusive : warning error has to be enabled*) + in + let number = + match number_opt with + | Some (Str { str = number}) -> Some number + | None -> None + | Some x -> Bsb_exception.config_error x "expect a string" + in + Some {number; error } + +let to_bsb_string ~toplevel warning = + match warning with + | None -> Ext_string.empty + | Some warning -> + (match warning.number with + | None -> + Ext_string.empty + | Some x -> + prepare_warning_concat ~beg:true x + ) ^ + if toplevel then + match warning.error with + | Warn_error_true -> + " -warn-error A" + | Warn_error_number y -> + " -warn-error " ^ y + | Warn_error_false -> + Ext_string.empty + else Ext_string.empty + + +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" -end = struct -#1 "hash_set_string.ml" -# 1 "ext/hash_set.cppo.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -# 31 "ext/hash_set.cppo.ml" -type key = string -let key_index (h : _ Hash_set_gen.t ) (key : key) = - (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) -let eq_key = Ext_string.equal -type t = key Hash_set_gen.t +external hash_string : string -> int = "caml_bs_hash_string" [@@noalloc];; -# 64 "ext/hash_set.cppo.ml" -let create = Hash_set_gen.create -let clear = Hash_set_gen.clear -let reset = Hash_set_gen.reset -(* let copy = Hash_set_gen.copy *) -let iter = Hash_set_gen.iter -let fold = Hash_set_gen.fold -let length = Hash_set_gen.length -(* let stats = Hash_set_gen.stats *) -let elements = Hash_set_gen.elements +external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" [@@noalloc];; +external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" [@@noalloc];; +external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" [@@noalloc];; -let remove (h : _ Hash_set_gen.t ) key = - let i = key_index h key in - let h_data = h.data in - Hash_set_gen.remove_bucket h i key ~prec:Empty (Array.unsafe_get h_data i) eq_key +external hash_small_int : int -> int = "caml_bs_hash_small_int" [@@noalloc];; +external hash_int : int -> int = "caml_bs_hash_int" [@@noalloc];; +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (Cons {key = key ; next = old_bucket}); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - -let check_add (h : _ Hash_set_gen.t) key : bool = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (Cons { key = key ; next = old_bucket}); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h; - true - end - else false - - -let mem (h : _ Hash_set_gen.t) key = - Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) - - end -module Bsb_config_types -= struct -#1 "bsb_config_types.ml" +module Ext_util : sig +#1 "ext_util.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7532,76 +7522,19 @@ module Bsb_config_types * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type dependency = - { - package_name : Bsb_pkg_types.t ; - package_install_path : string ; - } -type dependencies = dependency list - -(* `string` is a path to the entrypoint *) -type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string - -type compilation_kind_t = Js | Bytecode | Native - -type reason_react_jsx = - | Jsx_v2 - | Jsx_v3 - (* string option *) - -type refmt = string option - -type gentype_config = { - path : string (* resolved *) -} -type command = string + +val power_2_above : int -> int -> int -type ppx = { - name : string; - args : string list -} -type t = - { - package_name : string ; - (* [captial-package] *) - namespace : string option; - (* CapitalPackage *) - external_includes : string list ; - bsc_flags : string list ; - ppx_files : ppx list ; - pp_file : string option; - bs_dependencies : dependencies; - bs_dev_dependencies : dependencies; - built_in_dependency : dependency option; - warning : Bsb_warning.t; - (*TODO: maybe we should always resolve bs-platform - so that we can calculate correct relative path in - [.merlin] - *) - refmt : refmt; - js_post_build_cmd : string option; - package_specs : Bsb_package_specs.t ; - file_groups : Bsb_file_groups.t; - files_to_install : Hash_set_string.t ; - generate_merlin : bool ; - reason_react_jsx : reason_react_jsx option; (* whether apply PPX transform or not*) - entries : entries_t list ; - generators : command Map_string.t ; - cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) - bs_suffix : bool ; (* true means [.bs.js] we should pass [-bs-suffix] flag *) - gentype_config : gentype_config option; - number_of_dev_groups : int - } -end -module Ext_color : sig -#1 "ext_color.mli" +val stats_to_string : Hashtbl.statistics -> string +end = struct +#1 "ext_util.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -7626,29 +7559,29 @@ module Ext_color : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type color - = Black - | Red - | Green - | Yellow - | Blue - | Magenta - | Cyan - | White - -type style - = FG of color - | BG of color - | Bold - | Dim - -(** Input is the tag for example `@{@}` return escape code *) -val ansi_of_tag : string -> string +(** + {[ + (power_2_above 16 63 = 64) + (power_2_above 16 76 = 128) + ]} +*) +let rec power_2_above x n = + if x >= n then x + else if x * 2 > Sys.max_array_length then x + else power_2_above (x * 2) n -val reset_lit : string -end = struct -#1 "ext_color.ml" +let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = + Printf.sprintf + "bindings: %d,buckets: %d, longest: %d, hist:[%s]" + num_bindings + num_buckets + max_bucket_length + (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) +end +module Hash_set_gen += struct +#1 "hash_set_gen.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -7674,85 +7607,166 @@ end = struct * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) +type 'a bucket = + | Empty + | Cons of { + mutable key : 'a ; + mutable next : 'a bucket + } -type color - = Black - | Red - | Green - | Yellow - | Blue - | Magenta - | Cyan - | White +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a bucket array; (* the buckets *) + initial_size: int; (* initial array size *) + } -type style - = FG of color - | BG of color - | Bold - | Dim -let ansi_of_color = function - | Black -> "0" - | Red -> "1" - | Green -> "2" - | Yellow -> "3" - | Blue -> "4" - | Magenta -> "5" - | Cyan -> "6" - | White -> "7" -let code_of_style = function - | FG Black -> "30" - | FG Red -> "31" - | FG Green -> "32" - | FG Yellow -> "33" - | FG Blue -> "34" - | FG Magenta -> "35" - | FG Cyan -> "36" - | FG White -> "37" - - | BG Black -> "40" - | BG Red -> "41" - | BG Green -> "42" - | BG Yellow -> "43" - | BG Blue -> "44" - | BG Magenta -> "45" - | BG Cyan -> "46" - | BG White -> "47" +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; data = Array.make s Empty } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + Array.unsafe_set h.data i Empty + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size Empty + +let length h = h.size + +let resize indexfun h = + let odata = h.data in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + let ndata_tail = Array.make nsize Empty in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + Empty -> () + | Cons {key; next} as cell -> + let nidx = indexfun h key in + begin match Array.unsafe_get ndata_tail nidx with + | Empty -> + Array.unsafe_set ndata nidx cell + | Cons tail -> + tail.next <- cell + end; + Array.unsafe_set ndata_tail nidx cell; + insert_bucket next + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match Array.unsafe_get ndata_tail i with + | Empty -> () + | Cons tail -> tail.next <- Empty + done + end - | Bold -> "1" - | Dim -> "2" +let iter h f = + let rec do_bucket = function + | Empty -> + () + | Cons l -> + f l.key ; do_bucket l.next in + let d = h.data in + for i = 0 to Array.length d - 1 do + do_bucket (Array.unsafe_get d i) + done + +let fold h init f = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons l -> + do_bucket l.next (f l.key accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu +let elements set = + fold set [] List.cons -(** TODO: add more styles later *) -let style_of_tag s = match s with - | "error" -> [Bold; FG Red] - | "warning" -> [Bold; FG Magenta] - | "info" -> [Bold; FG Yellow] - | "dim" -> [Dim] - | "filename" -> [FG Cyan] - | _ -> [] -let ansi_of_tag s = - let l = style_of_tag s in - let s = String.concat ";" (Ext_list.map l code_of_style) in - "\x1b[" ^ s ^ "m" +let rec small_bucket_mem eq key lst = + match lst with + | Empty -> false + | Cons lst -> + eq key lst.key || + match lst.next with + | Empty -> false + | Cons lst -> + eq key lst.key || + match lst.next with + | Empty -> false + | Cons lst -> + eq key lst.key || + small_bucket_mem eq key lst.next -let reset_lit = "\x1b[0m" +let rec remove_bucket + (h : _ t) (i : int) + key + ~(prec : _ bucket) + (buck : _ bucket) + eq_key = + match buck with + | Empty -> + () + | Cons {key=k; next } -> + if eq_key k key + then begin + h.size <- h.size - 1; + match prec with + | Empty -> Array.unsafe_set h.data i next + | Cons c -> c.next <- next + end + else remove_bucket h i key ~prec:buck next eq_key +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + (* val copy: t -> t *) + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + (* val stats: t -> Hashtbl.statistics *) + val elements : t -> key list +end end -module Bsb_log : sig -#1 "bsb_log.mli" -(* Copyright (C) 2017 Authors of BuckleScript +module Hash_set_string : sig +#1 "hash_set_string.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -7777,31 +7791,12 @@ module Bsb_log : sig * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val setup : unit -> unit - -type level = - | Debug - | Info - | Warn - | Error - -val log_level : level ref - -type 'a fmt = Format.formatter -> ('a, Format.formatter, unit) format -> 'a - -type 'a log = ('a, Format.formatter, unit) format -> 'a - -val verbose : unit -> unit -val debug : 'a log -val info : 'a log -val warn : 'a log -val error : 'a log - -val info_args : string array -> unit +include Hash_set_gen.S with type key = string end = struct -#1 "bsb_log.ml" -(* Copyright (C) 2017- Authors of BuckleScript +#1 "hash_set_string.ml" +# 1 "ext/hash_set.cppo.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -7824,92 +7819,161 @@ end = struct * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +# 31 "ext/hash_set.cppo.ml" +type key = string +let key_index (h : _ Hash_set_gen.t ) (key : key) = + (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) +let eq_key = Ext_string.equal +type t = key Hash_set_gen.t +# 64 "ext/hash_set.cppo.ml" +let create = Hash_set_gen.create +let clear = Hash_set_gen.clear +let reset = Hash_set_gen.reset +(* let copy = Hash_set_gen.copy *) +let iter = Hash_set_gen.iter +let fold = Hash_set_gen.fold +let length = Hash_set_gen.length +(* let stats = Hash_set_gen.stats *) +let elements = Hash_set_gen.elements -let ninja_ansi_forced = lazy - (try Sys.getenv "NINJA_ANSI_FORCED" with - Not_found ->"" - ) -let color_enabled = lazy (Unix.isatty Unix.stdout) -(* same logic as [ninja.exe] *) -let get_color_enabled () = - let colorful = - match ninja_ansi_forced with - | lazy "1" -> true - | lazy ("0" | "false") -> false - | _ -> - Lazy.force color_enabled in - colorful +let remove (h : _ Hash_set_gen.t ) key = + let i = key_index h key in + let h_data = h.data in + Hash_set_gen.remove_bucket h i key ~prec:Empty (Array.unsafe_get h_data i) eq_key -let color_functions : Format.formatter_tag_functions = { - mark_open_tag = (fun s -> if get_color_enabled () then Ext_color.ansi_of_tag s else Ext_string.empty) ; - mark_close_tag = (fun _ -> if get_color_enabled () then Ext_color.reset_lit else Ext_string.empty); - print_open_tag = (fun _ -> ()); - print_close_tag = (fun _ -> ()) -} -let set_color ppf = - Format.pp_set_formatter_tag_functions ppf color_functions +let add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (Cons {key = key ; next = old_bucket}); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key : bool = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (Cons { key = key ; next = old_bucket}); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h; + true + end + else false -let setup () = - begin - Format.pp_set_mark_tags Format.std_formatter true ; - Format.pp_set_mark_tags Format.err_formatter true; - Format.pp_set_formatter_tag_functions - Format.std_formatter color_functions; - Format.pp_set_formatter_tag_functions - Format.err_formatter color_functions - end +let mem (h : _ Hash_set_gen.t) key = + Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) -type level = - | Debug - | Info - | Warn - | Error + -let int_of_level (x : level) = - match x with - | Debug -> 0 - | Info -> 1 - | Warn -> 2 - | Error -> 3 +end +module Bsb_config_types += struct +#1 "bsb_config_types.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let log_level = ref Warn -let verbose () = - log_level := Debug -let dfprintf level fmt = - if int_of_level level >= int_of_level !log_level then - Format.fprintf fmt - else Format.ifprintf fmt +type dependency = + { + package_name : Bsb_pkg_types.t ; + package_install_path : string ; + } +type dependencies = dependency list -type 'a fmt = - Format.formatter -> ('a, Format.formatter, unit) format -> 'a -type 'a log = - ('a, Format.formatter, unit) format -> 'a +(* `string` is a path to the entrypoint *) +type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string -let debug fmt = dfprintf Debug Format.std_formatter fmt -let info fmt = dfprintf Info Format.std_formatter fmt -let warn fmt = dfprintf Warn Format.err_formatter fmt -let error fmt = dfprintf Error Format.err_formatter fmt +type compilation_kind_t = Js | Bytecode | Native + +type reason_react_jsx = + | Jsx_v2 + | Jsx_v3 + (* string option *) +type refmt = string option -let info_args (args : string array) = - if int_of_level Info >= int_of_level !log_level then - begin - for i = 0 to Array.length args - 1 do - Format.pp_print_string Format.std_formatter (Array.unsafe_get args i) ; - Format.pp_print_string Format.std_formatter Ext_string.single_space; - done ; - Format.pp_print_newline Format.std_formatter () - end - else () - +type gentype_config = { + path : string (* resolved *) +} +type command = string + +type ppx = { + name : string; + args : string list +} +type t = + { + package_name : string ; + (* [captial-package] *) + namespace : string option; + (* CapitalPackage *) + external_includes : string list ; + bsc_flags : string list ; + ppx_files : ppx list ; + pp_file : string option; + bs_dependencies : dependencies; + bs_dev_dependencies : dependencies; + built_in_dependency : dependency option; + warning : Bsb_warning.t; + (*TODO: maybe we should always resolve bs-platform + so that we can calculate correct relative path in + [.merlin] + *) + refmt : refmt; + js_post_build_cmd : string option; + package_specs : Bsb_package_specs.t ; + file_groups : Bsb_file_groups.t; + files_to_install : Hash_set_string.t ; + generate_merlin : bool ; + reason_react_jsx : reason_react_jsx option; (* whether apply PPX transform or not*) + entries : entries_t list ; + generators : command Map_string.t ; + cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) + gentype_config : gentype_config option; + number_of_dev_groups : int + } end module Bsb_real_path : sig @@ -10246,7 +10310,7 @@ end module Bsb_parse_sources : sig #1 "bsb_parse_sources.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -10264,39 +10328,31 @@ module Bsb_parse_sources : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** [scan .. cxt json] - entry is to the [sources] in the schema - given a root, return an object which is - all relative paths, this function will do the IO -*) val scan : - toplevel: bool -> - root: string -> - cut_generators: bool -> - namespace : string option -> - bs_suffix:bool -> + toplevel:bool -> + root:string -> + cut_generators:bool -> + namespace:string option -> + bs_suffixes:string list -> ignored_dirs:Set_string.t -> - Ext_json_types.t -> - Bsb_file_groups.t * int + Ext_json_types.t -> + Bsb_file_groups.t * int +(** [scan .. cxt json] entry is to the [sources] in the schema given a root, + return an object which is all relative paths, this function will do the IO *) + +val clean_re_js : string -> unit +(** This function has some duplication from [scan], the parsing assuming the + format is already valid *) -(** This function has some duplication - from [scan], - the parsing assuming the format is - already valid -*) -val clean_re_js: - string -> unit end = struct #1 "bsb_parse_sources.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -10314,491 +10370,501 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type build_generator = Bsb_file_groups.build_generator - - type file_group = Bsb_file_groups.file_group -type t = Bsb_file_groups.t +type t = Bsb_file_groups.t -let is_input_or_output (xs : build_generator list) (x : string) = - Ext_list.exists xs (fun {input; output} -> - let it_is = fun y -> y = x in - Ext_list.exists input it_is || - Ext_list.exists output it_is - ) +let is_input_or_output (xs : build_generator list) (x : string) = + Ext_list.exists xs (fun { input; output } -> + let it_is y = y = x in + Ext_list.exists input it_is || Ext_list.exists output it_is) -let errorf x fmt = - Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt +let errorf x fmt = Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt type cxt = { - toplevel : bool ; - dir_index : Bsb_dir_index.t ; - cwd : string ; + toplevel : bool; + dir_index : Bsb_dir_index.t; + cwd : string; root : string; cut_generators : bool; traverse : bool; namespace : string option; - bs_suffix: bool; - ignored_dirs : Set_string.t + bs_suffixes : string list; + ignored_dirs : Set_string.t; } -(** [public] has a list of modules, we do a sanity check to see if all the listed - modules are indeed valid module components -*) -let collect_pub_modules - (xs : Ext_json_types.t array) - (cache : Bsb_db.t) : Set_string.t = - let set = ref Set_string.empty in - for i = 0 to Array.length xs - 1 do - let v = Array.unsafe_get xs i in - match v with - | Str { str} - -> - if Map_string.mem cache str then - set := Set_string.add !set str - else - Bsb_log.warn - "@{IGNORED@} %S in public is ignored since it is not\ - an existing module@." str - | _ -> - Bsb_exception.errorf - ~loc:(Ext_json.loc_of v) - "public excpect a list of strings" - done ; +(* [public] has a list of modules, we do a sanity check to see if all the listed + modules are indeed valid module components *) +let collect_pub_modules (xs : Ext_json_types.t array) (cache : Bsb_db.t) : + Set_string.t = + let set = ref Set_string.empty in + for i = 0 to Array.length xs - 1 do + let v = Array.unsafe_get xs i in + match v with + | Str { str } -> + if Map_string.mem cache str then set := Set_string.add !set str + else + Bsb_log.warn + "@{IGNORED@} %S in public is ignored since it is notan \ + existing module@." + str + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of v) + "public excpect a list of strings" + done; !set -let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) : Bsb_file_groups.public = - match Map_string.find_opt input Bsb_build_schemas.public with - | Some ((Str({str = s}) as x)) -> - if s = Bsb_build_schemas.export_all then Export_all else - if s = Bsb_build_schemas.export_none then Export_none else - errorf x "invalid str for %s " s - | Some (Arr {content = s}) -> - Export_set (collect_pub_modules s cur_sources) - | Some config -> - Bsb_exception.config_error config "expect array or string" - | None -> - Export_all -let extract_resources (input : Ext_json_types.t Map_string.t) : string list = - match Map_string.find_opt input Bsb_build_schemas.resources with - | Some (Arr x) -> - Bsb_build_util.get_list_string x.content - | Some config -> - Bsb_exception.config_error config - "expect array " - | None -> [] +let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) + : Bsb_file_groups.public = + match Map_string.find_opt input Bsb_build_schemas.public with + | Some (Str { str = s } as x) -> + if s = Bsb_build_schemas.export_all then Export_all + else if s = Bsb_build_schemas.export_none then Export_none + else errorf x "invalid str for %s " s + | Some (Arr { content = s }) -> Export_set (collect_pub_modules s cur_sources) + | Some config -> Bsb_exception.config_error config "expect array or string" + | None -> Export_all + + +let extract_resources (input : Ext_json_types.t Map_string.t) : string list = + match Map_string.find_opt input Bsb_build_schemas.resources with + | Some (Arr x) -> Bsb_build_util.get_list_string x.content + | Some config -> Bsb_exception.config_error config "expect array " + | None -> [] -let extract_input_output (edge : Ext_json_types.t) : string list * string list = - let error () = +let extract_input_output (edge : Ext_json_types.t) : string list * string list = + let error () = errorf edge {| invalid edge format, expect ["output" , ":", "input" ]|} - in - match edge with - | Arr {content} -> - (match Ext_array.find_and_split content - (fun x () -> match x with Str { str =":"} -> true | _ -> false ) - () with - | `No_split -> error () - | `Split ( output, input) -> - (Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str } -> - Some str - | _ -> None) output - , - Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str} -> - Some str (* More rigirous error checking: It would trigger a ninja syntax error *) - | _ -> None) input)) - | _ -> error () + in + match edge with + | Arr { content } -> ( + match + Ext_array.find_and_split content + (fun x () -> + match x with + | Str { str = ":" } -> true + | _ -> false) + () + with + | `No_split -> error () + | `Split (output, input) -> + ( Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> Some str + | _ -> None) + output, + Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> + Some str + (* More rigirous error checking: It would trigger a ninja + syntax error *) + | _ -> None) + input ) ) + | _ -> error () + + type json_map = Ext_json_types.t Map_string.t -let extract_generators (input : json_map) : build_generator list = - match Map_string.find_opt input Bsb_build_schemas.generators with - | Some (Arr { content ; loc_start}) -> - (* Need check is dev build or not *) - Ext_array.fold_left content [] (fun acc x -> - match x with - | Obj { map } -> - (match Map_string.find_opt map Bsb_build_schemas.name , - Map_string.find_opt map Bsb_build_schemas.edge - with - | Some (Str command), Some edge -> - let output, input = extract_input_output edge in - {Bsb_file_groups.input ; output ; command = command.str } :: acc - | _ -> - errorf x "Invalid generator format") - | _ -> errorf x "Invalid generator format" - ) - | Some x -> errorf x "Invalid generator format" +let extract_generators (input : json_map) : build_generator list = + match Map_string.find_opt input Bsb_build_schemas.generators with + | Some (Arr { content; loc_start }) -> + (* Need check is dev build or not *) + Ext_array.fold_left content [] (fun acc x -> + match x with + | Obj { map } -> ( + match + ( Map_string.find_opt map Bsb_build_schemas.name, + Map_string.find_opt map Bsb_build_schemas.edge ) + with + | Some (Str command), Some edge -> + let output, input = extract_input_output edge in + { Bsb_file_groups.input; output; command = command.str } + :: acc + | _ -> errorf x "Invalid generator format" ) + | _ -> errorf x "Invalid generator format") + | Some x -> errorf x "Invalid generator format" | None -> [] -let extract_predicate (m : json_map) : string -> bool = - let excludes = - match Map_string.find_opt m Bsb_build_schemas.excludes with - | None -> [] - | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr - | Some x -> Bsb_exception.config_error x "excludes expect array "in - let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in - match slow_re, excludes with - | Some (Str {str = s}), [] -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 - | Some (Str {str = s}) , _::_ -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 && not (Ext_list.mem_string excludes name) - | Some config, _ -> Bsb_exception.config_error config (Bsb_build_schemas.slow_re ^ " expect a string literal") - | None , _ -> - fun name -> not (Ext_list.mem_string excludes name) + +let extract_predicate (m : json_map) : string -> bool = + let excludes = + match Map_string.find_opt m Bsb_build_schemas.excludes with + | None -> [] + | Some (Arr { content = arr }) -> Bsb_build_util.get_list_string arr + | Some x -> Bsb_exception.config_error x "excludes expect array " + in + let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in + match (slow_re, excludes) with + | Some (Str { str = s }), [] -> + let re = Str.regexp s in + fun name -> Str.string_match re name 0 + | Some (Str { str = s }), _ :: _ -> + let re = Str.regexp s in + fun name -> + Str.string_match re name 0 && not (Ext_list.mem_string excludes name) + | Some config, _ -> + Bsb_exception.config_error config + (Bsb_build_schemas.slow_re ^ " expect a string literal") + | None, _ -> fun name -> not (Ext_list.mem_string excludes name) + (** [parsing_source_dir_map cxt input] - Major work done in this function, - assume [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] - is already checked, so we don't need check it again -*) -let try_unlink s = - try Unix.unlink s - with _ -> - Bsb_log.info "@{Failed to remove %s}@." s -let bs_cmt_post_process_cmd = + Major work done in this function, assume + [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] is already + checked, so we don't need check it again *) +let try_unlink s = + try Unix.unlink s with _ -> Bsb_log.info "@{Failed to remove %s}@." s + + +let bs_cmt_post_process_cmd = lazy (try Sys.getenv "BS_CMT_POST_PROCESS_CMD" with _ -> "") -type suffix_kind = - | Cmi of int | Cmt of int | Cmj of int | Cmti of int - | Not_any -let classify_suffix (x : string) : suffix_kind = - let i = - Ext_string.ends_with_index x Literals.suffix_cmi in - if i >=0 then Cmi i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmj in - if i >= 0 then Cmj i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmt in - if i >= 0 then Cmt i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmti in - if i >= 0 then Cmti i - else Not_any - -(** This is the only place where we do some removal during scanning, - configurabl -*) -let prune_staled_bs_js_files - (context : cxt) - (cur_sources : _ Map_string.t ) - : unit = - let lib_parent = - Filename.concat (Filename.concat context.root Bsb_config.lib_bs) - context.cwd in - if Sys.file_exists lib_parent then - let artifacts = Sys.readdir lib_parent in - Ext_array.iter artifacts (fun x -> - let kind = classify_suffix x in - match kind with - | Not_any -> () - | Cmi i | Cmt i | Cmj i | Cmti i -> - let j = - if context.namespace = None then i - else - Ext_string.rindex_neg x '-' - in - if j >= 0 then - let cmp = Ext_string.capitalize_sub x j in - if not (Map_string.mem cur_sources cmp) then - begin (* prune action *) - let filepath = Filename.concat lib_parent x in - (match kind with - | Cmt _ -> - let lazy cmd = bs_cmt_post_process_cmd in - - if cmd <> "" then - Ext_pervasives.try_it (fun _ -> - Sys.command ( - cmd ^ - " -cmt-rm " ^ filepath) - ) - | Cmj _ -> - (* remove .bs.js *) - if context.bs_suffix then - try_unlink - (Filename.concat context.cwd - (String.sub x 0 j ^ Literals.suffix_bs_js) - ) - | _ -> ()); - try_unlink filepath - end - else () (* assert false *) - ) +type suffix_kind = + | Cmi of int + | Cmt of int + | Cmj of int + | Cmti of int + | Not_any +let classify_suffix (x : string) : suffix_kind = + let i = Ext_string.ends_with_index x Literals.suffix_cmi in + if i >= 0 then Cmi i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmj in + if i >= 0 then Cmj i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmt in + if i >= 0 then Cmt i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmti in + if i >= 0 then Cmti i else Not_any +(** Attempt to delete any [.bs.[cm]?js] files for a given artifact. *) +let unlink_bs_suffixes context artifact = + List.iter + (fun suffix -> try_unlink (Filename.concat context.cwd (artifact ^ suffix))) + context.bs_suffixes -(********************************************************************) +(* This is the only place where we do some removal during scanning, + configurably. *) +let prune_staled_bs_js_files (context : cxt) (cur_sources : _ Map_string.t) : + unit = + let lib_parent = + Filename.concat (Filename.concat context.root Bsb_config.lib_bs) context.cwd + in + if Sys.file_exists lib_parent then + let artifacts = Sys.readdir lib_parent in + Ext_array.iter artifacts (fun x -> + let kind = classify_suffix x in + match kind with + | Not_any -> () + | Cmi i | Cmt i | Cmj i | Cmti i -> + let j = + if context.namespace = None then i + else Ext_string.rindex_neg x '-' + in + if j >= 0 then + let cmp = Ext_string.capitalize_sub x j in + if not (Map_string.mem cur_sources cmp) then ( + (* prune action *) + let filepath = Filename.concat lib_parent x in + ( match kind with + | Cmt _ -> + let (lazy cmd) = bs_cmt_post_process_cmd in + + if cmd <> "" then + Ext_pervasives.try_it (fun _ -> + Sys.command (cmd ^ " -cmt-rm " ^ filepath)) + | Cmj _ -> unlink_bs_suffixes context (String.sub x 0 j) + | _ -> () ); + try_unlink filepath ) + else () + (* assert false *)) + + +(* ****************************************************************** *) (* starts parsing *) -let rec - parsing_source_dir_map - ({ cwd = dir;} as cxt ) - (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t - = +let rec parsing_source_dir_map ({ cwd = dir } as cxt) + (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t = if Set_string.mem cxt.ignored_dirs dir then Bsb_file_groups.empty - else - let cur_globbed_dirs = ref false in - let has_generators = not (cxt.cut_generators || not cxt.toplevel) in - let scanned_generators = extract_generators input in - let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in - let base_name_array = - lazy (cur_globbed_dirs := true ; Sys.readdir (Filename.concat cxt.root dir)) in - let output_sources = - Ext_list.fold_left (Ext_list.flat_map scanned_generators (fun x -> x.output)) - Map_string.empty (fun acc o -> - Bsb_db_util.add_basename ~dir acc o) in - let sources = - match Map_string.find_opt input Bsb_build_schemas.files with - | None -> - (** We should avoid temporary files *) - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some (Arr basenames ) -> - Ext_array.fold_left basenames.content output_sources (fun acc basename -> - match basename with - | Str {str = basename;loc} -> - Bsb_db_util.add_basename ~dir acc basename ~error_on_invalid_suffix:loc - | _ -> acc - ) - | Some (Obj {map = map; loc} ) -> (* { excludes : [], slow_re : "" }*) - let predicate = extract_predicate map in - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename || not (predicate basename) then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some x -> Bsb_exception.config_error x "files field expect array or object " - in + else + let cur_globbed_dirs = ref false in + let has_generators = not (cxt.cut_generators || not cxt.toplevel) in + let scanned_generators = extract_generators input in + let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in + let base_name_array = + lazy + ( cur_globbed_dirs := true; + Sys.readdir (Filename.concat cxt.root dir) ) + in + let output_sources = + Ext_list.fold_left + (Ext_list.flat_map scanned_generators (fun x -> x.output)) + Map_string.empty + (fun acc o -> Bsb_db_util.add_basename ~dir acc o) + in + let sources = + match Map_string.find_opt input Bsb_build_schemas.files with + | None -> + (* We should avoid temporary files *) + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if is_input_or_output scanned_generators basename then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some (Arr basenames) -> + Ext_array.fold_left basenames.content output_sources + (fun acc basename -> + match basename with + | Str { str = basename; loc } -> + Bsb_db_util.add_basename ~dir acc basename + ~error_on_invalid_suffix:loc + | _ -> acc) + | Some (Obj { map; loc }) -> + (* { excludes : [], slow_re : "" }*) + let predicate = extract_predicate map in + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if + is_input_or_output scanned_generators basename + || not (predicate basename) + then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some x -> + Bsb_exception.config_error x "files field expect array or object " + in let resources = extract_resources input in - let public = extract_pub input sources in - (** Doing recursive stuff *) - let children = - match sub_dirs_field, - cxt.traverse with - | None , true - | Some (True _), _ -> - let root = cxt.root in - let parent = Filename.concat root dir in - Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty (fun origin x -> - if not (Set_string.mem cxt.ignored_dirs x) && - Sys.is_directory (Filename.concat parent x) then - Bsb_file_groups.merge - ( - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path x); - traverse = true - } Map_string.empty) origin - else origin - ) - (* readdir parent avoiding scanning twice *) - | None, false - | Some (False _), _ -> Bsb_file_groups.empty - | Some s, _ -> parse_sources cxt s - in - (** Do some clean up *) - prune_staled_bs_js_files cxt sources ; - Bsb_file_groups.cons - ~file_group:{ dir ; - sources = sources; - resources ; - public ; - dir_index = cxt.dir_index ; - generators = if has_generators then scanned_generators else [] } - ?globbed_dir:( - if !cur_globbed_dirs then Some dir else None) + let public = extract_pub input sources in + (* Doing recursive stuff *) + let children = + match (sub_dirs_field, cxt.traverse) with + | None, true | Some (True _), _ -> + let root = cxt.root in + let parent = Filename.concat root dir in + Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty + (fun origin x -> + if + (not (Set_string.mem cxt.ignored_dirs x)) + && Sys.is_directory (Filename.concat parent x) + then + Bsb_file_groups.merge + (parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path x); + traverse = true; + } + Map_string.empty) + origin + else origin) + (* readdir parent avoiding scanning twice *) + | None, false | Some (False _), _ -> Bsb_file_groups.empty + | Some s, _ -> parse_sources cxt s + in + (* Do some clean up *) + prune_staled_bs_js_files cxt sources; + Bsb_file_groups.cons + ~file_group: + { + dir; + sources; + resources; + public; + dir_index = cxt.dir_index; + generators = (if has_generators then scanned_generators else []); + } + ?globbed_dir:(if !cur_globbed_dirs then Some dir else None) children -and parsing_single_source ({toplevel; dir_index ; cwd} as cxt ) (x : Ext_json_types.t ) - : t = - match x with - | Str { str = dir } -> - if not toplevel && not (Bsb_dir_index.is_lib_dir dir_index) then - Bsb_file_groups.empty - else - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cwd (Ext_path.simple_convert_node_path_to_os_path dir)} - Map_string.empty - | Obj {map} -> - let current_dir_index = - match Map_string.find_opt map Bsb_build_schemas.type_ with - | Some (Str {str="dev"}) -> - Bsb_dir_index.get_dev_index () - | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} - | None -> dir_index in - if not toplevel && not (Bsb_dir_index.is_lib_dir current_dir_index) then - Bsb_file_groups.empty - else - let dir = - match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - Ext_path.simple_convert_node_path_to_os_path str - | Some x -> Bsb_exception.config_error x "dir expected to be a string" - | None -> - Bsb_exception.config_error x - ( - "required field :" ^ Bsb_build_schemas.dir ^ " missing" ) - +and parsing_single_source ({ toplevel; dir_index; cwd } as cxt) + (x : Ext_json_types.t) : t = + match x with + | Str { str = dir } -> + if (not toplevel) && not (Bsb_dir_index.is_lib_dir dir_index) then + Bsb_file_groups.empty + else + parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cwd + (Ext_path.simple_convert_node_path_to_os_path dir); + } + Map_string.empty + | Obj { map } -> + let current_dir_index = + match Map_string.find_opt map Bsb_build_schemas.type_ with + | Some (Str { str = "dev" }) -> Bsb_dir_index.get_dev_index () + | Some _ -> + Bsb_exception.config_error x {|type field expect "dev" literal |} + | None -> dir_index in - parsing_source_dir_map - {cxt with dir_index = current_dir_index; - cwd= Ext_path.concat cwd dir} map + if (not toplevel) && not (Bsb_dir_index.is_lib_dir current_dir_index) then + Bsb_file_groups.empty + else + let dir = + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + Ext_path.simple_convert_node_path_to_os_path str + | Some x -> Bsb_exception.config_error x "dir expected to be a string" + | None -> + Bsb_exception.config_error x + ("required field :" ^ Bsb_build_schemas.dir ^ " missing") + in + + parsing_source_dir_map + { + cxt with + dir_index = current_dir_index; + cwd = Ext_path.concat cwd dir; + } + map | _ -> Bsb_file_groups.empty -and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = - Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> - Bsb_file_groups.merge (parsing_single_source cxt x) origin - ) -and parse_sources ( cxt : cxt) (sources : Ext_json_types.t ) = - match sources with - | Arr file_groups -> - parsing_arr_sources cxt file_groups.content - | _ -> parsing_single_source cxt sources +and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = + Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> + Bsb_file_groups.merge (parsing_single_source cxt x) origin) -let scan - ~toplevel - ~root - ~cut_generators - ~namespace - ~bs_suffix - ~ignored_dirs - x : t * int = - Bsb_dir_index.reset (); - let output = - parse_sources { - ignored_dirs; - toplevel; - dir_index = Bsb_dir_index.lib_dir_index; - cwd = Filename.current_dir_name; - root ; - cut_generators; - namespace; - bs_suffix; - traverse = false - } x in - output, Bsb_dir_index.get_current_number_of_dev_groups () +and parse_sources (cxt : cxt) (sources : Ext_json_types.t) = + match sources with + | Arr file_groups -> parsing_arr_sources cxt file_groups.content + | _ -> parsing_single_source cxt sources + + +let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffixes ~ignored_dirs x + : t * int = + Bsb_dir_index.reset (); + let output = + parse_sources + { + ignored_dirs; + toplevel; + dir_index = Bsb_dir_index.lib_dir_index; + cwd = Filename.current_dir_name; + root; + cut_generators; + namespace; + bs_suffixes; + traverse = false; + } + x + in + (output, Bsb_dir_index.get_current_number_of_dev_groups ()) -(* Walk through to do some work *) +(* Walk through to do some work *) type walk_cxt = { - cwd : string ; - root : string; - traverse : bool; - ignored_dirs : Set_string.t; - } - -let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = - match sources with - | Arr {content} -> - Ext_array.iter content (fun x -> walk_single_source cxt x) - | x -> walk_single_source cxt x -and walk_single_source cxt (x : Ext_json_types.t) = - match x with - | Str {str = dir} - -> - let dir = Ext_path.simple_convert_node_path_to_os_path dir in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir } None - | Obj {map} -> - begin match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - let dir = Ext_path.simple_convert_node_path_to_os_path str in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir} (Map_string.find_opt map Bsb_build_schemas.subdirs) - | _ -> () - end - | _ -> () -and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = - let working_dir = Filename.concat cxt.root cxt.cwd in - if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then begin - let file_array = Sys.readdir working_dir in - (* Remove .re.js when clean up *) - Ext_array.iter file_array begin fun file -> - if Ext_string.ends_with file Literals.suffix_gen_js - || Ext_string.ends_with file Literals.suffix_gen_tsx - then - Sys.remove (Filename.concat working_dir file) - end; - let cxt_traverse = cxt.traverse in - match sub_dirs_field, cxt_traverse with - | None, true - | Some(True _), _ -> - Ext_array.iter file_array begin fun f -> - if not (Set_string.mem cxt.ignored_dirs f) && - Sys.is_directory (Filename.concat working_dir f ) then - walk_source_dir_map - {cxt with - cwd = - Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path f); - traverse = true - } None - end - | None, _ - | Some (False _), _ -> () - | Some s, _ -> walk_sources cxt s - end + cwd : string; + root : string; + traverse : bool; + ignored_dirs : Set_string.t; +} + +let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = + match sources with + | Arr { content } -> + Ext_array.iter content (fun x -> walk_single_source cxt x) + | x -> walk_single_source cxt x + + +and walk_single_source cxt (x : Ext_json_types.t) = + match x with + | Str { str = dir } -> + let dir = Ext_path.simple_convert_node_path_to_os_path dir in + walk_source_dir_map { cxt with cwd = Ext_path.concat cxt.cwd dir } None + | Obj { map } -> ( + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + let dir = Ext_path.simple_convert_node_path_to_os_path str in + walk_source_dir_map + { cxt with cwd = Ext_path.concat cxt.cwd dir } + (Map_string.find_opt map Bsb_build_schemas.subdirs) + | _ -> () ) + | _ -> () + + +and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = + let working_dir = Filename.concat cxt.root cxt.cwd in + if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then ( + let file_array = Sys.readdir working_dir in + (* Remove .re.js when clean up *) + Ext_array.iter file_array (fun file -> + if + Ext_string.ends_with file Literals.suffix_gen_js + || Ext_string.ends_with file Literals.suffix_gen_tsx + then Sys.remove (Filename.concat working_dir file)); + let cxt_traverse = cxt.traverse in + match (sub_dirs_field, cxt_traverse) with + | None, true | Some (True _), _ -> + Ext_array.iter file_array (fun f -> + if + (not (Set_string.mem cxt.ignored_dirs f)) + && Sys.is_directory (Filename.concat working_dir f) + then + walk_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path f); + traverse = true; + } + None) + | None, _ | Some (False _), _ -> () + | Some s, _ -> walk_sources cxt s ) + + (* It makes use of the side effect when [walk_sources], removing suffix_re_js, - TODO: make it configurable - *) -let clean_re_js root = - match Ext_json_parse.parse_json_from_file - (Filename.concat root Literals.bsconfig_json) with - | Obj { map } -> - let ignored_dirs = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with - | Some (Arr {content = x}) -> Set_string.of_list (Bsb_build_util.get_list_string x ) - | Some _ - | None -> Set_string.empty - in - Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) begin fun config -> - Ext_pervasives.try_it (fun () -> - walk_sources { root ; - traverse = true; - cwd = Filename.current_dir_name; - ignored_dirs - } config - ) - end - | _ -> () - | exception _ -> () - + TODO: make it configurable *) +let clean_re_js root = + match + Ext_json_parse.parse_json_from_file + (Filename.concat root Literals.bsconfig_json) + with + | Obj { map } -> + let ignored_dirs = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + | Some (Arr { content = x }) -> + Set_string.of_list (Bsb_build_util.get_list_string x) + | Some _ | None -> Set_string.empty + in + Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) + (fun config -> + Ext_pervasives.try_it (fun () -> + walk_sources + { + root; + traverse = true; + cwd = Filename.current_dir_name; + ignored_dirs; + } + config)) + | _ -> () + | exception _ -> () + end module Bsb_unix : sig #1 "bsb_unix.mli" @@ -11071,21 +11137,12 @@ module Bsb_config_parse : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val package_specs_from_bsconfig : - unit -> Bsb_package_specs.t - - - - -val interpret_json : - toplevel_package_specs:Bsb_package_specs.t option -> - per_proj_dir:string -> - Bsb_config_types.t - - - - +val package_specs_from_bsconfig : unit -> Bsb_package_specs.t +val interpret_json : + toplevel_package_specs:Bsb_package_specs.t option -> + per_proj_dir:string -> + Bsb_config_types.t end = struct #1 "bsb_config_parse.ml" @@ -11113,431 +11170,399 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let get_list_string = Bsb_build_util.get_list_string -let (//) = Ext_path.combine +let ( // ) = Ext_path.combine let current_package : Bsb_pkg_types.t = Global Bs_version.package_name -let resolve_package cwd package_name = - let x = Bsb_pkg.resolve_bs_package ~cwd package_name in +let resolve_package cwd package_name = + let x = Bsb_pkg.resolve_bs_package ~cwd package_name in { - Bsb_config_types.package_name ; - package_install_path = x // Bsb_config.lib_ocaml + Bsb_config_types.package_name; + package_install_path = x // Bsb_config.lib_ocaml; } + type json_map = Ext_json_types.t Map_string.t + (* Key is the path *) -let (|?) m (key, cb) = - m |> Ext_json.test key cb +let ( |? ) m (key, cb) = m |> Ext_json.test key cb +let extract_main_entries (map : json_map) = + [] -let extract_main_entries (map :json_map) = - - [] +let deprecated_extract_bs_suffix_exn (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | None -> None + | Some (Str { str } as config) -> + if str = Literals.suffix_js then Some false + else if str = Literals.suffix_bs_js then Some true + else + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports either `.js` or \ + `.bs.js`. Use 'suffix' under 'package-specs' instead." + | Some config -> + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports a string" -let package_specs_from_bsconfig () = - let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in - begin match json with - | Obj {map} -> - begin - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> - Bsb_package_specs.default_package_specs - end - | _ -> assert false - end +let package_specs_from_obj_map (map : json_map) = + let deprecated_bs_suffix = deprecated_extract_bs_suffix_exn map in + match Map_string.find_opt map Bsb_build_schemas.package_specs with + | Some x -> Bsb_package_specs.from_json ?deprecated_bs_suffix x + | None -> Bsb_package_specs.default_package_specs ?deprecated_bs_suffix () +let package_specs_from_bsconfig () = + let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in + match json with + | Obj { map } -> package_specs_from_obj_map map + | _ -> assert false (*TODO: it is a little mess that [cwd] and [project dir] are shared*) - -let extract_package_name_and_namespace - (map : json_map) : string * string option = - let package_name = - match Map_string.find_opt map Bsb_build_schemas.name with - - | Some (Str { str = "_" } as config) - -> - Bsb_exception.config_error config "_ is a reserved package name" - | Some (Str {str = name }) -> - name - | Some config -> - Bsb_exception.config_error config - "name expect a string field" - | None -> - Bsb_exception.invalid_spec - "field name is required" - in - let namespace = - match Map_string.find_opt map Bsb_build_schemas.namespace with - | None - | Some (False _) - -> None - | Some (True _) -> - Some (Ext_namespace.namespace_of_package_name package_name) - | Some (Str {str}) -> - (*TODO : check the validity of namespace *) - Some (Ext_namespace.namespace_of_package_name str) +let extract_package_name_and_namespace (map : json_map) : string * string option + = + let package_name = + match Map_string.find_opt map Bsb_build_schemas.name with + | Some (Str { str = "_" } as config) -> + Bsb_exception.config_error config "_ is a reserved package name" + | Some (Str { str = name }) -> name + | Some config -> + Bsb_exception.config_error config "name expect a string field" + | None -> Bsb_exception.invalid_spec "field name is required" + in + let namespace = + match Map_string.find_opt map Bsb_build_schemas.namespace with + | None | Some (False _) -> None + | Some (True _) -> + Some (Ext_namespace.namespace_of_package_name package_name) + | Some (Str { str }) -> + (*TODO : check the validity of namespace *) + Some (Ext_namespace.namespace_of_package_name str) | Some x -> - Bsb_exception.config_error x - "namespace field expects string or boolean" - in - package_name, namespace - - -(** - There are two things to check: - - the running bsb and vendoring bsb is the same - - the running bsb need delete stale build artifacts - (kinda check npm upgrade) -*) -let check_version_exit (map : json_map) stdlib_path = - match Map_string.find_exn map Bsb_build_schemas.version with - | Str {str } -> - if str <> Bs_version.version then - begin + Bsb_exception.config_error x "namespace field expects string or boolean" + in + (package_name, namespace) + + +(* There are two things to check: - the running bsb and vendoring bsb is the + same - the running bsb need delete stale build artifacts (kinda check npm + upgrade) *) +let check_version_exit (map : json_map) stdlib_path = + match Map_string.find_exn map Bsb_build_schemas.version with + | Str { str } -> + if str <> Bs_version.version then ( Format.fprintf Format.err_formatter - "@{bs-platform version mismatch@} Running bsb @{%s@} (%s) vs vendored @{%s@} (%s)@." + "@{bs-platform version mismatch@} Running bsb @{%s@} \ + (%s) vs vendored @{%s@} (%s)@." Bs_version.version (Filename.dirname (Filename.dirname Sys.executable_name)) - str - stdlib_path - ; - exit 2 - end + str stdlib_path; + exit 2 ) | _ -> assert false -let check_stdlib (map : json_map) cwd (*built_in_package*) = - match Map_string.find_opt map Bsb_build_schemas.use_stdlib with - | Some (False _) -> None - | None - | Some _ -> - begin - let stdlib_path = - Bsb_pkg.resolve_bs_package ~cwd current_package in - let json_spec = - Ext_json_parse.parse_json_from_file - (Filename.concat stdlib_path Literals.package_json) in - match json_spec with - | Obj {map} -> - check_version_exit map stdlib_path; - Some { - Bsb_config_types.package_name = current_package; - package_install_path = stdlib_path // Bsb_config.lib_ocaml; - } - | _ -> assert false - - end -let extract_bs_suffix_exn (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.suffix with - | None -> false - | Some (Str {str} as config ) -> - if str = Literals.suffix_js then false - else if str = Literals.suffix_bs_js then true - else Bsb_exception.config_error config - "expect .bs.js or .js string here" - | Some config -> - Bsb_exception.config_error config - "expect .bs.js or .js string here" - -let extract_gentype_config (map : json_map) cwd - : Bsb_config_types.gentype_config option = - match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with +let check_stdlib (map : json_map) cwd (*built_in_package*) = + match Map_string.find_opt map Bsb_build_schemas.use_stdlib with + | Some (False _) -> None + | None | Some _ -> ( + let stdlib_path = Bsb_pkg.resolve_bs_package ~cwd current_package in + let json_spec = + Ext_json_parse.parse_json_from_file + (Filename.concat stdlib_path Literals.package_json) + in + match json_spec with + | Obj { map } -> + check_version_exit map stdlib_path; + Some + { + Bsb_config_types.package_name = current_package; + package_install_path = stdlib_path // Bsb_config.lib_ocaml; + } + | _ -> assert false ) + + +let extract_gentype_config (map : json_map) cwd : + Bsb_config_types.gentype_config option = + match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with | None -> None - | Some (Obj {map = obj}) -> - Some { path = - match Map_string.find_opt obj Bsb_build_schemas.path with - | None -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" - "gentype/gentype.exe").path - | Some (Str {str}) -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" str).path - | Some config -> - Bsb_exception.config_error config - "path expect to be a string" - } - - | Some config -> - Bsb_exception.config_error - config "gentypeconfig expect an object" - -let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = - match Map_string.find_opt map Bsb_build_schemas.refmt with - | Some (Flo {flo} as config) -> - begin match flo with + | Some (Obj { map = obj }) -> + Some + { + path = + ( match Map_string.find_opt obj Bsb_build_schemas.path with + | None -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + "gentype/gentype.exe") + .path + | Some (Str { str }) -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + str) + .path + | Some config -> + Bsb_exception.config_error config "path expect to be a string" + ); + } + | Some config -> + Bsb_exception.config_error config "gentypeconfig expect an object" + + +let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = + match Map_string.find_opt map Bsb_build_schemas.refmt with + | Some (Flo { flo } as config) -> ( + match flo with | "3" -> None - | _ -> Bsb_exception.config_error config "expect version 3 only" - end - | Some (Str {str}) - -> - Some - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:Bsb_build_schemas.refmt str).path - | Some config -> - Bsb_exception.config_error config "expect version 2 or 3" - | None -> - None - -let extract_string (map : json_map) (field : string) cb = - match Map_string.find_opt map field with - | None -> None - | Some (Str{str}) -> cb str - | Some config -> - Bsb_exception.config_error config (field ^ " expect a string" ) - -let extract_boolean (map : json_map) (field : string) (default : bool) : bool = - match Map_string.find_opt map field with - | None -> default - | Some (True _ ) -> true - | Some (False _) -> false - | Some config -> - Bsb_exception.config_error config (field ^ " expect a boolean" ) - -let extract_reason_react_jsx (map : json_map) = - let default : Bsb_config_types.reason_react_jsx option ref = ref None in + | _ -> Bsb_exception.config_error config "expect version 3 only" ) + | Some (Str { str }) -> + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.refmt str) + .path + | Some config -> Bsb_exception.config_error config "expect version 2 or 3" + | None -> None + + +let extract_string (map : json_map) (field : string) cb = + match Map_string.find_opt map field with + | None -> None + | Some (Str { str }) -> cb str + | Some config -> Bsb_exception.config_error config (field ^ " expect a string") + + +let extract_boolean (map : json_map) (field : string) (default : bool) : bool = + match Map_string.find_opt map field with + | None -> default + | Some (True _) -> true + | Some (False _) -> false + | Some config -> + Bsb_exception.config_error config (field ^ " expect a boolean") + + +let extract_reason_react_jsx (map : json_map) = + let default : Bsb_config_types.reason_react_jsx option ref = ref None in map - |? (Bsb_build_schemas.reason, `Obj begin fun m -> - match Map_string.find_opt m Bsb_build_schemas.react_jsx with - | Some (Flo{loc; flo}) -> - begin match flo with - | "2" -> - default := Some Jsx_v2 - | "3" -> - default := Some Jsx_v3 - | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo - end - | Some x -> Bsb_exception.config_error x - "Unexpected input (expect a version number) for jsx, note boolean is no longer allowed" - | None -> () - end) + |? ( Bsb_build_schemas.reason, + `Obj + (fun m -> + match Map_string.find_opt m Bsb_build_schemas.react_jsx with + | Some (Flo { loc; flo }) -> ( + match flo with + | "2" -> default := Some Jsx_v2 + | "3" -> default := Some Jsx_v3 + | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo + ) + | Some x -> + Bsb_exception.config_error x + "Unexpected input (expect a version number) for jsx, note \ + boolean is no longer allowed" + | None -> ()) ) |> ignore; !default -let extract_warning (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.warnings with - | None -> Bsb_warning.use_default - | Some (Obj {map }) -> Bsb_warning.from_map map + +let extract_warning (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.warnings with + | None -> Bsb_warning.use_default + | Some (Obj { map }) -> Bsb_warning.from_map map | Some config -> Bsb_exception.config_error config "expect an object" -let extract_ignored_dirs (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + +let extract_ignored_dirs (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with | None -> Set_string.empty - | Some (Arr {content}) -> - Set_string.of_list (Bsb_build_util.get_list_string content) - | Some config -> - Bsb_exception.config_error config "expect an array of string" - -let extract_generators (map : json_map) = - let generators = ref Map_string.empty in - (match Map_string.find_opt map Bsb_build_schemas.generators with - | None -> () - | Some (Arr {content = s}) -> - generators := - Ext_array.fold_left s Map_string.empty (fun acc json -> - match json with - | Obj {map = m ; loc} -> - begin match Map_string.find_opt m Bsb_build_schemas.name, - Map_string.find_opt m Bsb_build_schemas.command with - | Some (Str {str = name}), Some ( Str {str = command}) -> - Map_string.add acc name command - | _, _ -> - Bsb_exception.errorf ~loc {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} - end - | _ -> acc ) - | Some config -> - Bsb_exception.config_error config (Bsb_build_schemas.generators ^ " expect an array field") - ); + | Some (Arr { content }) -> + Set_string.of_list (Bsb_build_util.get_list_string content) + | Some config -> Bsb_exception.config_error config "expect an array of string" + + +let extract_generators (map : json_map) = + let generators = ref Map_string.empty in + ( match Map_string.find_opt map Bsb_build_schemas.generators with + | None -> () + | Some (Arr { content = s }) -> + generators := + Ext_array.fold_left s Map_string.empty (fun acc json -> + match json with + | Obj { map = m; loc } -> ( + match + ( Map_string.find_opt m Bsb_build_schemas.name, + Map_string.find_opt m Bsb_build_schemas.command ) + with + | Some (Str { str = name }), Some (Str { str = command }) -> + Map_string.add acc name command + | _, _ -> + Bsb_exception.errorf ~loc + {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} + ) + | _ -> acc) + | Some config -> + Bsb_exception.config_error config + (Bsb_build_schemas.generators ^ " expect an array field") ); !generators - -let extract_dependencies (map : json_map) cwd (field : string ) - : Bsb_config_types.dependencies = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr ({content = s})) -> - Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s)) - | Some config -> - Bsb_exception.config_error config - (field ^ " expect an array") - -(* return an empty array if not found *) -let extract_string_list (map : json_map) (field : string) : string list = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr {content = s}) -> - Bsb_build_util.get_list_string s - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") - -let extract_ppx - (map : json_map) - (field : string) - ~(cwd : string) : Bsb_config_types.ppx list = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr {content }) -> - let resolve s = - if s = "" then Bsb_exception.invalid_spec "invalid ppx, empty string found" - else - (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.ppx_flags s).path in - Ext_array.to_list_f content (fun x -> - match x with - | Str x -> - - {Bsb_config_types.name = - resolve x.str; - args = []} - | Arr {content } -> - - let xs = Bsb_build_util.get_list_string content in - (match xs with - | [] -> Bsb_exception.config_error x " empty array is not allowed" - | name :: args -> - {Bsb_config_types.name = resolve name ; args} - ) - | config -> Bsb_exception.config_error config - (field ^ "expect each item to be either string or array") - ) - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") +let extract_dependencies (map : json_map) cwd (field : string) : + Bsb_config_types.dependencies = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content = s }) -> + Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> + resolve_package cwd (Bsb_pkg_types.string_as_package s)) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") -let extract_js_post_build (map : json_map) cwd : string option = - let js_post_build_cmd = ref None in - map - |? (Bsb_build_schemas.js_post_build, `Obj begin fun m -> - m |? (Bsb_build_schemas.cmd , `Str (fun s -> - js_post_build_cmd := Some (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.js_post_build s).path +(* return an empty array if not found *) +let extract_string_list (map : json_map) (field : string) : string list = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content = s }) -> Bsb_build_util.get_list_string s + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") - ) - ) - |> ignore - end) - |> ignore ; +let extract_ppx (map : json_map) (field : string) ~(cwd : string) : + Bsb_config_types.ppx list = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content }) -> + let resolve s = + if s = "" then + Bsb_exception.invalid_spec "invalid ppx, empty string found" + else + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.ppx_flags s) + .path + in + Ext_array.to_list_f content (fun x -> + match x with + | Str x -> { Bsb_config_types.name = resolve x.str; args = [] } + | Arr { content } -> ( + let xs = Bsb_build_util.get_list_string content in + match xs with + | [] -> Bsb_exception.config_error x " empty array is not allowed" + | name :: args -> { Bsb_config_types.name = resolve name; args } ) + | config -> + Bsb_exception.config_error config + (field ^ "expect each item to be either string or array")) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") + + +let extract_js_post_build (map : json_map) cwd : string option = + let js_post_build_cmd = ref None in + map + |? ( Bsb_build_schemas.js_post_build, + `Obj + (fun m -> + m + |? ( Bsb_build_schemas.cmd, + `Str + (fun s -> + js_post_build_cmd := + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.js_post_build s) + .path) ) + |> ignore) ) + |> ignore; !js_post_build_cmd -(** ATT: make sure such function is re-entrant. - With a given [cwd] it works anywhere*) -let interpret_json - ~toplevel_package_specs - ~per_proj_dir:(per_proj_dir:string) - : Bsb_config_types.t = - - (** we should not resolve it too early, - since it is external configuration, no {!Bsb_build_util.convert_and_resolve_path} - *) - - - - - (* When we plan to add more deps here, - Make sure check it is consistent that for nested deps, we have a - quck check by just re-parsing deps - Make sure it works with [-make-world] [-clean-world] - *) - +(* ATT: make sure such function is re-entrant. With a given [cwd] it works + anywhere *) +let interpret_json ~toplevel_package_specs ~(per_proj_dir : string) : + Bsb_config_types.t = + (* we should not resolve it too early, since it is external configuration, no + {!Bsb_build_util.convert_and_resolve_path} *) + (* When we plan to add more deps here, make sure check it is consistent that + for nested deps, we have a quck check by just re-parsing deps. Make sure it + works with [-make-world] [-clean-world]. *) (* Setting ninja is a bit complex + 1. if [build.ninja] does use [ninja] we need set a variable - 2. we need store it so that we can call ninja correctly - *) - match Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) with - | Obj { map } -> - let package_name, namespace = - extract_package_name_and_namespace map in - let refmt = extract_refmt map per_proj_dir in - let gentype_config = extract_gentype_config map per_proj_dir in - let bs_suffix = extract_bs_suffix_exn map in - (* The default situation is empty *) - let built_in_package = check_stdlib map per_proj_dir in - let package_specs = - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> Bsb_package_specs.default_package_specs - in - let pp_flags : string option = - extract_string map Bsb_build_schemas.pp_flags (fun p -> - if p = "" then - Bsb_exception.invalid_spec "invalid pp, empty string found" - else - Some (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir ~desc:Bsb_build_schemas.pp_flags p).path - ) in - let reason_react_jsx = extract_reason_react_jsx map in - let bs_dependencies = extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies in - let toplevel = toplevel_package_specs = None in - let bs_dev_dependencies = - if toplevel then - extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dev_dependencies - else [] in - begin match Map_string.find_opt map Bsb_build_schemas.sources with - | Some sources -> - let cut_generators = - extract_boolean map Bsb_build_schemas.cut_generators false in - let groups, number_of_dev_groups = Bsb_parse_sources.scan - ~ignored_dirs:(extract_ignored_dirs map) - ~toplevel - ~root: per_proj_dir - ~cut_generators - ~bs_suffix - ~namespace - sources in - { - gentype_config; - bs_suffix ; - package_name ; - namespace ; - warning = extract_warning map; - external_includes = extract_string_list map Bsb_build_schemas.bs_external_includes; - bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags ; - ppx_files = extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; - pp_file = pp_flags ; - bs_dependencies ; - bs_dev_dependencies ; - (* - reference for quoting - {[ - let tmpfile = Filename.temp_file "ocamlpp" "" in - let comm = Printf.sprintf "%s %s > %s" - pp (Filename.quote sourcefile) tmpfile - in - ]} - *) - refmt; - js_post_build_cmd = (extract_js_post_build map per_proj_dir); - package_specs = - (match toplevel_package_specs with - | None -> package_specs - | Some x -> x ); - file_groups = groups; - files_to_install = Hash_set_string.create 96; - built_in_dependency = built_in_package; - generate_merlin = - extract_boolean map Bsb_build_schemas.generate_merlin true; - reason_react_jsx ; - entries = extract_main_entries map; - generators = extract_generators map ; - cut_generators ; - number_of_dev_groups; - } - | None -> - Bsb_exception.invalid_spec - "no sources specified in bsconfig.json" - end - | _ -> - Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" + + 2. we need store it so that we can call ninja correctly *) + match + Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) + with + | Obj { map } -> ( + let package_name, namespace = extract_package_name_and_namespace map in + let refmt = extract_refmt map per_proj_dir in + let gentype_config = extract_gentype_config map per_proj_dir in + (* The default situation is empty *) + let built_in_package = check_stdlib map per_proj_dir in + let package_specs = package_specs_from_obj_map map in + let bs_suffixes = + Bsb_package_specs.extract_in_source_bs_suffixes package_specs + in + let pp_flags : string option = + extract_string map Bsb_build_schemas.pp_flags (fun p -> + if p = "" then + Bsb_exception.invalid_spec "invalid pp, empty string found" + else + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir + ~desc:Bsb_build_schemas.pp_flags p) + .path) + in + let reason_react_jsx = extract_reason_react_jsx map in + let bs_dependencies = + extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies + in + let toplevel = toplevel_package_specs = None in + let bs_dev_dependencies = + if toplevel then + extract_dependencies map per_proj_dir + Bsb_build_schemas.bs_dev_dependencies + else [] + in + match Map_string.find_opt map Bsb_build_schemas.sources with + | Some sources -> + let cut_generators = + extract_boolean map Bsb_build_schemas.cut_generators false + in + let groups, number_of_dev_groups = + Bsb_parse_sources.scan ~ignored_dirs:(extract_ignored_dirs map) + ~toplevel ~root:per_proj_dir ~cut_generators ~bs_suffixes + ~namespace sources + in + { + gentype_config; + package_name; + namespace; + warning = extract_warning map; + external_includes = + extract_string_list map Bsb_build_schemas.bs_external_includes; + bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags; + ppx_files = + extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; + pp_file = pp_flags; + bs_dependencies; + bs_dev_dependencies; + (* reference for quoting {[ let tmpfile = Filename.temp_file + "ocamlpp" "" in let comm = Printf.sprintf "%s %s > %s" pp + (Filename.quote sourcefile) tmpfile in ]} *) + refmt; + js_post_build_cmd = extract_js_post_build map per_proj_dir; + package_specs = + ( match toplevel_package_specs with + | None -> package_specs + | Some x -> x ); + file_groups = groups; + files_to_install = Hash_set_string.create 96; + built_in_dependency = built_in_package; + generate_merlin = + extract_boolean map Bsb_build_schemas.generate_merlin true; + reason_react_jsx; + entries = extract_main_entries map; + generators = extract_generators map; + cut_generators; + number_of_dev_groups; + } + | None -> + Bsb_exception.invalid_spec "no sources specified in bsconfig.json" ) + | _ -> Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" end module Ext_io : sig @@ -12456,65 +12481,55 @@ module Bsb_ninja_rule : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - +type t (** The complexity comes from the fact that we allow custom rules which could - conflict with our custom built-in rules -*) -type t + conflict with our custom built-in rules *) - -val get_name : t -> out_channel -> string +val get_name : t -> out_channel -> string (***********************************************************) -(** A list of existing rules *) + type builtin = { - build_ast : t; - build_ast_from_re : t ; - - (** platform dependent, on Win32, - invoking cmd.exe - *) - copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_ast_from_re : t; + copy_resources : t; (** platform dependent, on Win32, invoking cmd.exe *) + build_bin_deps : t; (** Rules below all need restat *) ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } -(***********************************************************) +(** A list of existing rules *) -(** rules are generally composed of built-in rules and customized rules, there are two design choices: - 1. respect custom rules with the same name, then we need adjust our built-in - rules dynamically in case the conflict. - 2. respect our built-in rules, then we only need re-load custom rules for each bsconfig.json -*) +(***********************************************************) type command = string -(** Since now we generate ninja files per bsconfig.json in a single process, - we must make sure it is re-entrant -*) -val make_custom_rules : + +val make_custom_rules : has_gentype:bool -> has_postbuild:bool -> has_ppx:bool -> has_pp:bool -> - has_builtin:bool -> - bs_suffix:bool -> - reason_react_jsx : Bsb_config_types.reason_react_jsx option -> + has_builtin:bool -> + reason_react_jsx:Bsb_config_types.reason_react_jsx option -> digest:string -> refmt:string option -> command Map_string.t -> builtin +(** rules are generally composed of built-in rules and customized rules, there + are two design choices: + + + respect custom rules with the same name, then we need adjust our built-in + rules dynamically in case the conflict. + + respect our built-in rules, then we only need re-load custom rules for + each bsconfig.json + NOTE: Since now we generate ninja files per bsconfig.json in a single + process, we must make sure it is re-entrant *) end = struct #1 "bsb_ninja_rule.ml" @@ -12542,241 +12557,178 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -type t = { - mutable used : bool; - rule_name : string; - name : out_channel -> string +type t = { + mutable used : bool; + rule_name : string; + name : out_channel -> string; } let get_name (x : t) oc = x.name oc -let print_rule (oc : out_channel) - ~description - ?(restat : unit option) - ?dyndep - ~command - name = - output_string oc "rule "; output_string oc name ; output_string oc "\n"; - output_string oc " command = "; output_string oc command; output_string oc "\n"; +let print_rule (oc : out_channel) ~description ?(restat : unit option) ?dyndep + ~command name = + output_string oc "rule "; + output_string oc name; + output_string oc "\n"; + output_string oc " command = "; + output_string oc command; + output_string oc "\n"; Ext_option.iter dyndep (fun f -> - output_string oc " dyndep = "; output_string oc f; output_string oc "\n" - ); - (if restat <> None then - output_string oc " restat = 1\n"); - - output_string oc " description = " ; output_string oc description; output_string oc "\n" - + output_string oc " dyndep = "; + output_string oc f; + output_string oc "\n"); + if restat <> None then output_string oc " restat = 1\n"; + output_string oc " description = "; + output_string oc description; + output_string oc "\n" (** allocate an unique name for such rule*) -let define - ~command - ?dyndep - ?restat - ?(description = "\027[34mBuilding\027[39m \027[2m${out}\027[22m") (* blue, dim *) - rule_name : t - = - - let rec self = { - used = false; - rule_name ; - name = fun oc -> - if not self.used then - begin - print_rule oc ~description ?dyndep ?restat ~command rule_name; - self.used <- true - end ; - rule_name - } in +let define ~command ?dyndep ?restat + ?(description = + "\027[34mBuilding\027[39m \027[2m${out}\027[22m" (* blue, dim *)) + rule_name : t = + let rec self = + { + used = false; + rule_name; + name = + (fun oc -> + if not self.used then ( + print_rule oc ~description ?dyndep ?restat ~command rule_name; + self.used <- true ); + rule_name); + } + in self - - type command = string type builtin = { build_ast : t; - (** TODO: Implement it on top of pp_flags *) - build_ast_from_re : t ; + (* TODO: Implement it on top of pp_flags *) + build_ast_from_re : t; (* build_ast_from_rei : t ; *) - - - (** platform dependent, on Win32, - invoking cmd.exe - *) copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_bin_deps : t; ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } - -;; - -let make_custom_rules - ~(has_gentype : bool) - ~(has_postbuild : bool) - ~(has_ppx : bool) - ~(has_pp : bool) - ~(has_builtin : bool) - ~(bs_suffix : bool) - ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) - ~(digest : string) - ~(refmt : string option) (* set refmt path when needed *) - (custom_rules : command Map_string.t) : - builtin = - (** FIXME: We don't need set [-o ${out}] when building ast - since the default is already good -- it does not*) - let buf = Buffer.create 100 in - let mk_ml_cmj_cmd - ~read_cmi - ~is_dev - ~postbuild : string = +let make_custom_rules ~(has_gentype : bool) ~(has_postbuild : bool) + ~(has_ppx : bool) ~(has_pp : bool) ~(has_builtin : bool) + ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) + ~(digest : string) ~(refmt : string option) + (* set refmt path when needed *) + (custom_rules : command Map_string.t) : builtin = + (* FIXME: We don't need set [-o ${out}] when building ast since the default is + already good -- it does not *) + let buf = Buffer.create 100 in + let mk_ml_cmj_cmd ~read_cmi ~is_dev ~postbuild : string = Buffer.clear buf; Buffer.add_string buf "$bsc -nostdlib $g_pkg_flg -color always"; - if bs_suffix then - Buffer.add_string buf " -bs-suffix"; - if read_cmi then - Buffer.add_string buf " -bs-read-cmi"; - if is_dev then - Buffer.add_string buf " $g_dev_incls"; - Buffer.add_string buf " $g_lib_incls" ; - if is_dev then - Buffer.add_string buf " $g_dpkg_incls"; - if has_builtin then - Buffer.add_string buf " -I $g_std_incl"; + if read_cmi then Buffer.add_string buf " -bs-read-cmi"; + if is_dev then Buffer.add_string buf " $g_dev_incls"; + Buffer.add_string buf " $g_lib_incls"; + if is_dev then Buffer.add_string buf " $g_dpkg_incls"; + if has_builtin then Buffer.add_string buf " -I $g_std_incl"; Buffer.add_string buf " $warnings $bsc_flags"; - if has_gentype then - Buffer.add_string buf " $gentypeconfig"; + if has_gentype then Buffer.add_string buf " $gentypeconfig"; Buffer.add_string buf " -o $out $in"; - if postbuild then - Buffer.add_string buf " $postbuild"; + if postbuild then Buffer.add_string buf " $postbuild"; Buffer.contents buf - in + in let mk_ast ~(has_pp : bool) ~has_ppx ~has_reason_react_jsx : string = - Buffer.clear buf ; + Buffer.clear buf; Buffer.add_string buf "$bsc $warnings -color always"; - (match refmt with + ( match refmt with | None -> () | Some x -> - Buffer.add_string buf " -bs-refmt "; - Buffer.add_string buf (Ext_filename.maybe_quote x); - ); - if has_pp then - Buffer.add_string buf " $pp_flags"; - (match has_reason_react_jsx, reason_react_jsx with - | false, _ - | _, None -> () - | _, Some Jsx_v2 - -> Buffer.add_string buf " -bs-jsx 2" - | _, Some Jsx_v3 - -> Buffer.add_string buf " -bs-jsx 3" - ); - if has_ppx then - Buffer.add_string buf " $ppx_flags"; - Buffer.add_string buf " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; + Buffer.add_string buf " -bs-refmt "; + Buffer.add_string buf (Ext_filename.maybe_quote x) ); + if has_pp then Buffer.add_string buf " $pp_flags"; + ( match (has_reason_react_jsx, reason_react_jsx) with + | false, _ | _, None -> () + | _, Some Jsx_v2 -> Buffer.add_string buf " -bs-jsx 2" + | _, Some Jsx_v3 -> Buffer.add_string buf " -bs-jsx 3" ); + if has_ppx then Buffer.add_string buf " $ppx_flags"; + Buffer.add_string buf + " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; Buffer.contents buf - in + in let build_ast = define - ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false ) - "build_ast" in + ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false) + "build_ast" + in let build_ast_from_re = define ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:true) - "build_ast_from_re" in - - let copy_resources = - define - ~command:( - if Ext_sys.is_windows_or_cygwin then - "cmd.exe /C copy /Y $in $out > null" - else "cp $in $out" - ) - "copy_resource" in - let build_bin_deps = + "build_ast_from_re" + in + + let copy_resources = define - ~restat:() ~command: - ("$bsdep -hash " ^ digest ^" $g_ns -g $bsb_dir_group $in") - "build_deps" in - let aux ~name ~read_cmi ~postbuild = - let postbuild = has_postbuild && postbuild in - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:false - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - name, - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:true - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - (name ^ "_dev") - in + ( if Ext_sys.is_windows_or_cygwin then + "cmd.exe /C copy /Y $in $out > null" + else "cp $in $out" ) + "copy_resource" + in + let build_bin_deps = + define ~restat:() + ~command:("$bsdep -hash " ^ digest ^ " $g_ns -g $bsb_dir_group $in") + "build_deps" + in + let aux ~name ~read_cmi ~postbuild = + let postbuild = has_postbuild && postbuild in + ( define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:false ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) name, + define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:true ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) + (name ^ "_dev") ) + in (* [g_lib_incls] are fixed for libs *) let ml_cmj_js, ml_cmj_js_dev = - aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true in + aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true + in let ml_cmj_cmi_js, ml_cmj_cmi_js_dev = - aux - ~read_cmi:false - ~name:"ml_cmj_cmi" ~postbuild:true in + aux ~read_cmi:false ~name:"ml_cmj_cmi" ~postbuild:true + in let ml_cmi, ml_cmi_dev = - aux - ~read_cmi:false ~postbuild:false - ~name:"ml_cmi" in - let build_package = - define - ~command:"$bsc -w -49 -color always -no-alias-deps $in" - ~restat:() + aux ~read_cmi:false ~postbuild:false ~name:"ml_cmi" + in + let build_package = + define ~command:"$bsc -w -49 -color always -no-alias-deps $in" ~restat:() "build_package" - in + in { - build_ast ; - build_ast_from_re ; - (** platform dependent, on Win32, - invoking cmd.exe - *) + build_ast; + build_ast_from_re; copy_resources; - (** Rules below all need restat *) - build_bin_deps ; - - ml_cmj_js ; - ml_cmj_js_dev ; - ml_cmj_cmi_js ; - ml_cmi ; - + build_bin_deps; + ml_cmj_js; + ml_cmj_js_dev; + ml_cmj_cmi_js; + ml_cmi; ml_cmj_cmi_js_dev; ml_cmi_dev; - - build_package ; + build_package; customs = - Map_string.mapi custom_rules begin fun name command -> - define ~command ("custom_" ^ name) - end + Map_string.mapi custom_rules (fun name command -> + define ~command ("custom_" ^ name)); } - - end module Bsb_ninja_targets : sig #1 "bsb_ninja_targets.mli" @@ -13027,18 +12979,15 @@ module Bsb_ninja_file_groups : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - val handle_files_per_dir : out_channel -> - bs_suffix:bool -> rules:Bsb_ninja_rule.builtin -> package_specs:Bsb_package_specs.t -> js_post_build_cmd:string option -> files_to_install:Hash_set_string.t -> - namespace:string option -> - Bsb_file_groups.file_group -> unit + namespace:string option -> + Bsb_file_groups.file_group -> + unit end = struct #1 "bsb_ninja_file_groups.ml" @@ -13066,199 +13015,156 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - - - - - +let ( // ) = Ext_path.combine -let handle_generators oc - (group : Bsb_file_groups.file_group) - custom_rules = - let map_to_source_dir = - (fun x -> Bsb_config.proj_rel (group.dir //x )) in - Ext_list.iter group.generators (fun {output; input; command} -> +let handle_generators oc (group : Bsb_file_groups.file_group) custom_rules = + let map_to_source_dir x = Bsb_config.proj_rel (group.dir // x) in + Ext_list.iter group.generators (fun { output; input; command } -> (*TODO: add a loc for better error message *) - match Map_string.find_opt custom_rules command with - | None -> Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" command - | Some rule -> - Bsb_ninja_targets.output_build oc - ~outputs:(Ext_list.map output map_to_source_dir) - ~inputs:(Ext_list.map input map_to_source_dir) - ~rule - ) - - -let make_common_shadows - package_specs - dirname - dir_index - : Bsb_ninja_targets.shadow list - = - - { key = Bsb_ninja_global_vars.g_pkg_flg; - op = - Append - (Bsb_package_specs.package_flag_of_package_specs - package_specs dirname - ) - } :: - (if Bsb_dir_index.is_lib_dir dir_index then [] else - [ - { key = Bsb_ninja_global_vars.g_dev_incls; - op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); - } - ] - ) - - - -let emit_module_build - (rules : Bsb_ninja_rule.builtin) - (package_specs : Bsb_package_specs.t) - (group_dir_index : Bsb_dir_index.t) - oc - ~bs_suffix - js_post_build_cmd - namespace - (module_info : Bsb_db.module_info) - = - let has_intf_file = module_info.info = Ml_mli in - let is_re = module_info.is_re in - let filename_sans_extension = module_info.name_sans_extension in + match Map_string.find_opt custom_rules command with + | None -> + Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" + command + | Some rule -> + Bsb_ninja_targets.output_build oc + ~outputs:(Ext_list.map output map_to_source_dir) + ~inputs:(Ext_list.map input map_to_source_dir) + ~rule) + + +let make_common_shadows package_specs dirname dir_index : + Bsb_ninja_targets.shadow list = + { + key = Bsb_ninja_global_vars.g_pkg_flg; + op = + Append + (Bsb_package_specs.flags_of_package_specs package_specs dirname); + } + :: + ( if Bsb_dir_index.is_lib_dir dir_index then [] + else + [ + { + key = Bsb_ninja_global_vars.g_dev_incls; + op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); + }; + ] ) + + +let emit_module_build (rules : Bsb_ninja_rule.builtin) + (package_specs : Bsb_package_specs.t) (group_dir_index : Bsb_dir_index.t) oc + js_post_build_cmd namespace (module_info : Bsb_db.module_info) = + let has_intf_file = module_info.info = Ml_mli in + let is_re = module_info.is_re in + let filename_sans_extension = module_info.name_sans_extension in let is_dev = not (Bsb_dir_index.is_lib_dir group_dir_index) in - let input_impl = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) in - let input_intf = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_rei else Literals.suffix_mli) in - let output_mlast = - filename_sans_extension ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast in - let output_mliast = - filename_sans_extension ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast in + let input_impl = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) + in + let input_intf = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_rei else Literals.suffix_mli ) + in + let output_mlast = + filename_sans_extension + ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast + in + let output_mliast = + filename_sans_extension + ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast + in let output_d = filename_sans_extension ^ Literals.suffix_d in - let output_filename_sans_extension = - Ext_namespace.make ?ns:namespace filename_sans_extension - in - let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in - let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in + let output_filename_sans_extension = + Ext_namespace.make ?ns:namespace filename_sans_extension + in + let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in + let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in let output_js = - Bsb_package_specs.get_list_of_output_js package_specs bs_suffix output_filename_sans_extension in - let common_shadows = + Bsb_package_specs.get_list_of_output_js package_specs + output_filename_sans_extension + in + let common_shadows = make_common_shadows package_specs (Filename.dirname output_cmi) - group_dir_index in - let ast_rule = - if is_re then - rules.build_ast_from_re - else - rules.build_ast in - Bsb_ninja_targets.output_build oc - ~outputs:[output_mlast] - ~inputs:[input_impl] - ~rule:ast_rule; - Bsb_ninja_targets.output_build - oc - ~outputs:[output_d] - ~inputs:(if has_intf_file then [output_mlast;output_mliast] else [output_mlast] ) + group_dir_index + in + let ast_rule = if is_re then rules.build_ast_from_re else rules.build_ast in + Bsb_ninja_targets.output_build oc ~outputs:[ output_mlast ] + ~inputs:[ input_impl ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_d ] + ~inputs: + ( if has_intf_file then [ output_mlast; output_mliast ] + else [ output_mlast ] ) ~rule:rules.build_bin_deps - ?shadows:(if is_dev then - Some [{Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group ; - op = - Overwrite (string_of_int (group_dir_index :> int)) }] - else None) - ; - if has_intf_file then begin - Bsb_ninja_targets.output_build oc - ~outputs:[output_mliast] - (* TODO: we can get rid of absloute path if we fixed the location to be - [lib/bs], better for testing? - *) - ~inputs:[input_intf] - ~rule:ast_rule - ; + ?shadows: + ( if is_dev then + Some + [ + { + Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group; + op = Overwrite (string_of_int (group_dir_index :> int)); + }; + ] + else None ); + if has_intf_file then ( Bsb_ninja_targets.output_build oc - ~outputs:[output_cmi] - ~shadows:common_shadows - ~order_only_deps:[output_d] - ~inputs:[output_mliast] - ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) - ; - end; + ~outputs: + [ output_mliast ] + (* TODO: we can get rid of absloute path if we fixed the location to be + [lib/bs], better for testing? *) + ~inputs:[ input_intf ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmi ] + ~shadows:common_shadows ~order_only_deps:[ output_d ] + ~inputs:[ output_mliast ] + ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) ); let shadows = match js_post_build_cmd with | None -> common_shadows | Some cmd -> - {key = Bsb_ninja_global_vars.postbuild; - op = Overwrite ("&& " ^ cmd ^ Ext_string.single_space ^ String.concat Ext_string.single_space output_js)} - :: common_shadows + { + key = Bsb_ninja_global_vars.postbuild; + op = + Overwrite + ( "&& " ^ cmd ^ Ext_string.single_space + ^ String.concat Ext_string.single_space output_js ); + } + :: common_shadows in let rule = - if has_intf_file then - (if is_dev then rules.ml_cmj_js_dev - else rules.ml_cmj_js) - else - (if is_dev then rules.ml_cmj_cmi_js_dev - else rules.ml_cmj_cmi_js - ) + if has_intf_file then + if is_dev then rules.ml_cmj_js_dev else rules.ml_cmj_js + else if is_dev then rules.ml_cmj_cmi_js_dev + else rules.ml_cmj_cmi_js in - Bsb_ninja_targets.output_build oc - ~outputs:[output_cmj] - ~shadows - ~implicit_outputs: - (if has_intf_file then output_js else output_cmi::output_js ) - ~inputs:[output_mlast] - ~implicit_deps:(if has_intf_file then [output_cmi] else [] ) - ~order_only_deps:[output_d] - ~rule - (* ; - {output_cmj; output_cmi} *) - - - - - - -let handle_files_per_dir - oc - ~bs_suffix - ~(rules : Bsb_ninja_rule.builtin) - ~package_specs - ~js_post_build_cmd - ~(files_to_install : Hash_set_string.t) - ~(namespace : string option) - (group: Bsb_file_groups.file_group ) - : unit = - - handle_generators oc group rules.customs ; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmj ] ~shadows + ~implicit_outputs: + (if has_intf_file then output_js else output_cmi :: output_js) + ~inputs:[ output_mlast ] + ~implicit_deps:(if has_intf_file then [ output_cmi ] else []) + ~order_only_deps:[ output_d ] ~rule + + +let handle_files_per_dir oc ~(rules : Bsb_ninja_rule.builtin) ~package_specs + ~js_post_build_cmd ~(files_to_install : Hash_set_string.t) + ~(namespace : string option) (group : Bsb_file_groups.file_group) : unit = + handle_generators oc group rules.customs; let installable = match group.public with | Export_all -> fun _ -> true | Export_none -> fun _ -> false - | Export_set set -> - fun module_name -> - Set_string.mem set module_name in - Map_string.iter group.sources (fun module_name module_info -> - if installable module_name then - Hash_set_string.add files_to_install - module_info.name_sans_extension; - emit_module_build rules - package_specs - group.dir_index - oc - ~bs_suffix - js_post_build_cmd - namespace module_info - ) - - (* ; - Bsb_ninja_targets.phony - oc ~order_only_deps:[] ~inputs:[] ~output:group.dir *) + | Export_set set -> fun module_name -> Set_string.mem set module_name + in + Map_string.iter group.sources (fun module_name module_info -> + if installable module_name then + Hash_set_string.add files_to_install module_info.name_sans_extension; + emit_module_build rules package_specs group.dir_index oc js_post_build_cmd + namespace module_info) - (* pseuduo targets per directory *) +(* pseuduo targets per directory *) end module Bsb_ninja_gen : sig @@ -13287,13 +13193,9 @@ module Bsb_ninja_gen : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - generate ninja file based on [cwd] -*) val output_ninja_and_namespace_map : - per_proj_dir:string -> - toplevel:bool -> - Bsb_config_types.t -> unit + per_proj_dir:string -> toplevel:bool -> Bsb_config_types.t -> unit +(** generate ninja file based on [cwd] *) end = struct #1 "bsb_ninja_gen.ml" @@ -13321,235 +13223,196 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - -(* we need copy package.json into [_build] since it does affect build output - it is a bad idea to copy package.json which requires to copy js files -*) - - +let ( // ) = Ext_path.combine +(* we need copy package.json into [_build] since it does affect build output it + is a bad idea to copy package.json which requires to copy js files *) let dash_i = "-I" +let get_bsc_flags ~(toplevel : bool) (bsc_flags : string list) : string = + String.concat Ext_string.single_space + (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags) + + +let emit_bsc_lib_includes (bs_dependencies : Bsb_config_types.dependencies) + (source_dirs : string list) external_includes (namespace : _ option) + (oc : out_channel) : unit = + (* TODO: bsc_flags contain stdlib path which is in the latter position + currently *) + let all_includes source_dirs = + source_dirs + @ Ext_list.map bs_dependencies (fun x -> x.package_install_path) + @ (* for external includes, if it is absolute path, leave it as is for + relative path './xx', we need '../.././x' since we are in [lib/bs], + [build] is different from merlin though *) + Ext_list.map external_includes (fun x -> + if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) + in + Bsb_ninja_targets.output_kv Bsb_build_schemas.g_lib_incls + (Bsb_build_util.include_dirs + (all_includes + ( if namespace = None then source_dirs + else Filename.current_dir_name :: source_dirs + (*working dir is [lib/bs] we include this path to have namespace + mapping*) ))) + oc -let get_bsc_flags - ~(toplevel : bool) - (bsc_flags : string list) - : string = - String.concat Ext_string.single_space - (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags ) - - -let emit_bsc_lib_includes - (bs_dependencies : Bsb_config_types.dependencies) - (source_dirs : string list) - (external_includes) - (namespace : _ option) - (oc : out_channel): unit = - (* TODO: bsc_flags contain stdlib path which is in the latter position currently *) - let all_includes source_dirs = - source_dirs @ - Ext_list.map bs_dependencies (fun x -> x.package_install_path) @ - ( - (* for external includes, if it is absolute path, leave it as is - for relative path './xx', we need '../.././x' since we are in - [lib/bs], [build] is different from merlin though - *) - Ext_list.map - external_includes - - (fun x -> if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) - ) - in - Bsb_ninja_targets.output_kv - Bsb_build_schemas.g_lib_incls - (Bsb_build_util.include_dirs - (all_includes - (if namespace = None then source_dirs - else Filename.current_dir_name :: source_dirs - (*working dir is [lib/bs] we include this path to have namespace mapping*) - ))) oc - - -let output_static_resources - (static_resources : string list) - copy_rule - oc - = - Ext_list.iter static_resources (fun output -> - Bsb_ninja_targets.output_build - oc - ~outputs:[output] - ~inputs:[Bsb_config.proj_rel output] +let output_static_resources (static_resources : string list) copy_rule oc = + Ext_list.iter static_resources (fun output -> + Bsb_ninja_targets.output_build oc ~outputs:[ output ] + ~inputs:[ Bsb_config.proj_rel output ] ~rule:copy_rule); if static_resources <> [] then - Bsb_ninja_targets.phony - oc - ~order_only_deps:static_resources - ~inputs:[] - ~output:Literals.build_ninja + Bsb_ninja_targets.phony oc ~order_only_deps:static_resources ~inputs:[] + ~output:Literals.build_ninja -let output_ninja_and_namespace_map - ~per_proj_dir - ~toplevel +let output_ninja_and_namespace_map ~per_proj_dir ~toplevel ({ - bs_suffix; - package_name; - external_includes; - bsc_flags ; - pp_file; - ppx_files ; - - bs_dependencies; - bs_dev_dependencies; - refmt; - js_post_build_cmd; - package_specs; - file_groups = { files = bs_file_groups}; - files_to_install; - built_in_dependency; - reason_react_jsx; - generators ; - namespace ; - warning; - gentype_config; - number_of_dev_groups; - } : Bsb_config_types.t) : unit - = - - let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in + package_name; + external_includes; + bsc_flags; + pp_file; + ppx_files; + bs_dependencies; + bs_dev_dependencies; + refmt; + js_post_build_cmd; + package_specs; + file_groups = { files = bs_file_groups }; + files_to_install; + built_in_dependency; + reason_react_jsx; + generators; + namespace; + warning; + gentype_config; + number_of_dev_groups; + } : + Bsb_config_types.t) : unit = + let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in let ppx_flags = Bsb_build_util.ppx_flags ppx_files in - let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in - let g_pkg_flg , g_ns_flg = + let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in + let g_pkg_flg, g_ns_flg = match namespace with - | None -> - Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty - | Some s -> - Ext_string.inter4 - "-bs-package-name" package_name - "-bs-ns" s - , - Ext_string.inter2 "-bs-ns" s in - let () = + | None -> + (Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty) + | Some s -> + ( Ext_string.inter4 "-bs-package-name" package_name "-bs-ns" s, + Ext_string.inter2 "-bs-ns" s ) + in + let () = Ext_option.iter pp_file (fun flag -> Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.pp_flags - (Bsb_build_util.pp_flag flag) oc - ); - Ext_option.iter gentype_config (fun x -> + (Bsb_build_util.pp_flag flag) + oc); + Ext_option.iter gentype_config (fun x -> (* resolved earlier *) Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.gentypeconfig - ("-bs-gentype " ^ x.path) oc - ); - Ext_option.iter built_in_dependency (fun x -> - Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl - (Ext_filename.maybe_quote x.package_install_path) oc - ) - ; - + ("-bs-gentype " ^ x.path) oc); + Ext_option.iter built_in_dependency (fun x -> + Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl + (Ext_filename.maybe_quote x.package_install_path) + oc); Bsb_ninja_targets.output_kvs [| - Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg ; - Bsb_ninja_global_vars.src_root_dir, per_proj_dir (* TODO: need check its integrity -- allow relocate or not? *); - (* The path to [bsc.exe] independent of config *) - Bsb_ninja_global_vars.bsc, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc); + (Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg); + (Bsb_ninja_global_vars.src_root_dir, per_proj_dir) + (* TODO: need check its integrity -- allow relocate or not? *); + (* The path to [bsc.exe] independent of config *) + ( Bsb_ninja_global_vars.bsc, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc ); (* The path to [bsb_heler.exe] *) - Bsb_ninja_global_vars.bsdep, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep) ; - Bsb_ninja_global_vars.warnings, Bsb_warning.to_bsb_string ~toplevel warning ; - Bsb_ninja_global_vars.bsc_flags, (get_bsc_flags ~toplevel bsc_flags) ; - Bsb_ninja_global_vars.ppx_flags, ppx_flags; - - Bsb_ninja_global_vars.g_dpkg_incls, - (Bsb_build_util.include_dirs_by - bs_dev_dependencies - (fun x -> x.package_install_path)); - Bsb_ninja_global_vars.g_ns , g_ns_flg ; - Bsb_build_schemas.bsb_dir_group, "0" (*TODO: avoid name conflict in the future *) - |] oc - in - let bs_groups, bsc_lib_dirs, static_resources = - if number_of_dev_groups = 0 then - let bs_group, source_dirs,static_resources = - Ext_list.fold_left bs_file_groups (Map_string.empty,[],[]) - (fun (acc, dirs,acc_resources) ({sources ; dir; resources } as x) - -> - Bsb_db_util.merge acc sources , - (if Bsb_file_groups.is_empty x then dirs else dir::dirs) , - ( if resources = [] then acc_resources - else Ext_list.map_append resources acc_resources (fun x -> dir // x ) ) - ) in + ( Bsb_ninja_global_vars.bsdep, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep ); + ( Bsb_ninja_global_vars.warnings, + Bsb_warning.to_bsb_string ~toplevel warning ); + (Bsb_ninja_global_vars.bsc_flags, get_bsc_flags ~toplevel bsc_flags); + (Bsb_ninja_global_vars.ppx_flags, ppx_flags); + ( Bsb_ninja_global_vars.g_dpkg_incls, + Bsb_build_util.include_dirs_by bs_dev_dependencies (fun x -> + x.package_install_path) ); + (Bsb_ninja_global_vars.g_ns, g_ns_flg); + (Bsb_build_schemas.bsb_dir_group, "0") + (*TODO: avoid name conflict in the future *); + |] + oc + in + let bs_groups, bsc_lib_dirs, static_resources = + if number_of_dev_groups = 0 then ( + let bs_group, source_dirs, static_resources = + Ext_list.fold_left bs_file_groups (Map_string.empty, [], []) + (fun (acc, dirs, acc_resources) ({ sources; dir; resources } as x) -> + ( Bsb_db_util.merge acc sources, + (if Bsb_file_groups.is_empty x then dirs else dir :: dirs), + if resources = [] then acc_resources + else + Ext_list.map_append resources acc_resources (fun x -> dir // x) + )) + in Bsb_db_util.sanity_check bs_group; - [|bs_group|], source_dirs, static_resources + ([| bs_group |], source_dirs, static_resources) ) else - let bs_groups = Array.init (number_of_dev_groups + 1 ) (fun i -> Map_string.empty) in - let source_dirs = Array.init (number_of_dev_groups + 1 ) (fun i -> []) in + let bs_groups = + Array.init (number_of_dev_groups + 1) (fun i -> Map_string.empty) + in + let source_dirs = Array.init (number_of_dev_groups + 1) (fun i -> []) in let static_resources = - Ext_list.fold_left bs_file_groups [] (fun (acc_resources : string list) {sources; dir; resources; dir_index} - -> - let dir_index = (dir_index :> int) in - bs_groups.(dir_index) <- Bsb_db_util.merge bs_groups.(dir_index) sources ; + Ext_list.fold_left bs_file_groups [] + (fun (acc_resources : string list) + { sources; dir; resources; dir_index } + -> + let dir_index = (dir_index :> int) in + bs_groups.(dir_index) <- + Bsb_db_util.merge bs_groups.(dir_index) sources; source_dirs.(dir_index) <- dir :: source_dirs.(dir_index); - Ext_list.map_append resources acc_resources (fun x -> dir//x) - ) in - let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in + Ext_list.map_append resources acc_resources (fun x -> dir // x)) + in + let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in Bsb_db_util.sanity_check lib; - for i = 1 to number_of_dev_groups do + for i = 1 to number_of_dev_groups do let c = bs_groups.(i) in Bsb_db_util.sanity_check c; - Map_string.iter c - (fun k a -> - if Map_string.mem lib k then - Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k) - ) ; - Bsb_ninja_targets.output_kv - (Bsb_dir_index.(string_of_bsb_dev_include (of_int i))) - (Bsb_build_util.include_dirs source_dirs.(i)) oc - done ; - bs_groups,source_dirs.((Bsb_dir_index.lib_dir_index:>int)), static_resources + Map_string.iter c (fun k a -> + if Map_string.mem lib k then + Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k)); + Bsb_ninja_targets.output_kv + Bsb_dir_index.(string_of_bsb_dev_include (of_int i)) + (Bsb_build_util.include_dirs source_dirs.(i)) + oc + done; + ( bs_groups, + source_dirs.((Bsb_dir_index.lib_dir_index :> int)), + static_resources ) in let digest = Bsb_db_encode.write_build_cache ~dir:cwd_lib_bs bs_groups in - let rules : Bsb_ninja_rule.builtin = - Bsb_ninja_rule.make_custom_rules - ~refmt - ~has_gentype:(gentype_config <> None) + let rules : Bsb_ninja_rule.builtin = + Bsb_ninja_rule.make_custom_rules ~refmt ~has_gentype:(gentype_config <> None) ~has_postbuild:(js_post_build_cmd <> None) - ~has_ppx:(ppx_files <> []) - ~has_pp:(pp_file <> None) + ~has_ppx:(ppx_files <> []) ~has_pp:(pp_file <> None) ~has_builtin:(built_in_dependency <> None) - ~reason_react_jsx - ~bs_suffix - ~digest - generators in - - emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace oc; - output_static_resources static_resources rules.copy_resources oc ; - (** Generate build statement for each file *) - Ext_list.iter bs_file_groups - (fun files_per_dir -> - Bsb_ninja_file_groups.handle_files_per_dir oc - ~bs_suffix - ~rules - ~js_post_build_cmd - ~package_specs - ~files_to_install - ~namespace files_per_dir) - ; + ~reason_react_jsx ~digest generators + in - Ext_option.iter namespace (fun ns -> - let namespace_dir = - per_proj_dir // Bsb_config.lib_bs in - Bsb_namespace_map_gen.output - ~dir:namespace_dir ns - bs_file_groups; - Bsb_ninja_targets.output_build oc - ~outputs:[ns ^ Literals.suffix_cmi] - ~inputs:[ns ^ Literals.suffix_mlmap] - ~rule:rules.build_package - ); + emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace + oc; + output_static_resources static_resources rules.copy_resources oc; + (* Generate build statement for each file *) + Ext_list.iter bs_file_groups (fun files_per_dir -> + Bsb_ninja_file_groups.handle_files_per_dir oc ~rules ~js_post_build_cmd + ~package_specs ~files_to_install ~namespace files_per_dir); + + Ext_option.iter namespace (fun ns -> + let namespace_dir = per_proj_dir // Bsb_config.lib_bs in + Bsb_namespace_map_gen.output ~dir:namespace_dir ns bs_file_groups; + Bsb_ninja_targets.output_build oc + ~outputs:[ ns ^ Literals.suffix_cmi ] + ~inputs:[ ns ^ Literals.suffix_mlmap ] + ~rule:rules.build_package); close_out oc end diff --git a/lib/4.06.1/bsb_helper.ml b/lib/4.06.1/bsb_helper.ml index 193854c203..3f8fb6fab6 100644 --- a/lib/4.06.1/bsb_helper.ml +++ b/lib/4.06.1/bsb_helper.ml @@ -2877,7 +2877,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -2895,7 +2895,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -2905,7 +2905,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -2918,9 +2918,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -2963,7 +2963,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -2973,48 +2973,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -3032,7 +3037,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -3046,7 +3051,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -3105,8 +3110,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -3114,19 +3119,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -3145,9 +3155,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Bsb_db_decode : sig #1 "bsb_db_decode.mli" @@ -3650,7 +3661,7 @@ end module Ext_namespace : sig #1 "ext_namespace.mli" (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -3668,64 +3679,38 @@ module Ext_namespace : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option - +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string end = struct #1 "ext_namespace.ml" - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -3743,115 +3728,116 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + #1933 when removing ns suffix, don't pass the bound of basename - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false - - -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext + + +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) + + +type leading_case = Upper | Lower + +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext + + +(** https://docs.npmjs.com/files/package.json + + Some rules: + + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. + + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = if off >= len then () - else + else let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end module Ext_option : sig diff --git a/lib/4.06.1/bsdep.ml b/lib/4.06.1/bsdep.ml index f6e94eaa1c..a9ae60fca1 100644 --- a/lib/4.06.1/bsdep.ml +++ b/lib/4.06.1/bsdep.ml @@ -36150,7 +36150,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -36168,96 +36168,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -36285,83 +36263,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -36381,7 +36323,7 @@ end module Bs_warnings : sig #1 "bs_warnings.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -36399,29 +36341,27 @@ module Bs_warnings : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit end = struct #1 "bs_warnings.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -36439,117 +36379,106 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - + Format.pp_print_flush warning_formatter () ) -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) +(** Note the standard way of reporting error in compiler: + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error + Define an error type + type error exception Error of Location.t * error -(** - Note the standard way of reporting error in compiler: - - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error - - Define an error type + Provide a printer to error - type error - exception Error of Location.t * error - - Provide a printer to error - - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) end module Ext_util : sig @@ -37153,7 +37082,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -37171,7 +37100,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -37181,7 +37110,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -37194,9 +37123,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -37239,7 +37168,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -37249,48 +37178,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -37308,7 +37242,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -37322,7 +37256,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -37381,8 +37315,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -37390,19 +37324,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -37421,9 +37360,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ast_attributes : sig #1 "ast_attributes.mli" diff --git a/lib/4.06.1/bsppx.ml b/lib/4.06.1/bsppx.ml index 4133dfe0a9..c879eac508 100644 --- a/lib/4.06.1/bsppx.ml +++ b/lib/4.06.1/bsppx.ml @@ -4818,7 +4818,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -4836,96 +4836,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -4953,83 +4931,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -293557,7 +293499,7 @@ end module Bs_warnings : sig #1 "bs_warnings.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -293575,29 +293517,27 @@ module Bs_warnings : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit end = struct #1 "bs_warnings.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -293615,117 +293555,106 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) + Format.pp_print_flush warning_formatter () ) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) +(** Note the standard way of reporting error in compiler: + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error -(** - Note the standard way of reporting error in compiler: - - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error - - Define an error type + Define an error type - type error - exception Error of Location.t * error + type error exception Error of Location.t * error - Provide a printer to error + Provide a printer to error - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) end module Ext_util : sig @@ -294329,7 +294258,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -294347,7 +294276,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -294357,7 +294286,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -294370,9 +294299,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -294415,7 +294344,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -294425,48 +294354,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -294484,7 +294418,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -294498,7 +294432,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -294557,8 +294491,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -294566,19 +294500,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -294597,9 +294536,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ast_attributes : sig #1 "ast_attributes.mli" diff --git a/lib/4.06.1/unstable/all_ounit_tests.ml b/lib/4.06.1/unstable/all_ounit_tests.ml index 16118ce371..7486340c9f 100644 --- a/lib/4.06.1/unstable/all_ounit_tests.ml +++ b/lib/4.06.1/unstable/all_ounit_tests.ml @@ -5006,7 +5006,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -5024,7 +5024,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -5034,7 +5034,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -5047,9 +5047,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -5092,7 +5092,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -5102,48 +5102,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -5161,7 +5166,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -5175,7 +5180,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -5234,8 +5239,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -5243,19 +5248,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -5274,9 +5284,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ounit_cmd_util : sig #1 "ounit_cmd_util.mli" @@ -7657,7 +7668,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7675,96 +7686,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref +(** return [package_name] and [path] when in script mode: *) -(** return [package_name] and [path] - when in script mode: -*) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) - -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) - -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -7792,83 +7781,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -16334,7 +16287,7 @@ end module Ext_namespace : sig #1 "ext_namespace.mli" (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -16352,64 +16305,38 @@ module Ext_namespace : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option - -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string end = struct #1 "ext_namespace.ml" - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -16427,115 +16354,116 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + #1933 when removing ns suffix, don't pass the bound of basename - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false - - -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext + + +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) + + +type leading_case = Upper | Lower + +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext + + +(** https://docs.npmjs.com/files/package.json + + Some rules: + + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. + + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = if off >= len then () - else + else let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end module Ounit_data_random @@ -16557,34 +16485,34 @@ module Ounit_string_tests let ((>::), (>:::)) = OUnit.((>::),(>:::)) -let (=~) = OUnit.assert_equal ~printer:Ext_obj.dump +let (=~) = OUnit.assert_equal ~printer:Ext_obj.dump -let printer_string = fun x -> x +let printer_string = fun x -> x let string_eq = OUnit.assert_equal ~printer:(fun id -> id) -let suites = - __FILE__ >::: +let suites = + __FILE__ >::: [ __LOC__ >:: begin fun _ -> OUnit.assert_bool "not found " (Ext_string.rindex_neg "hello" 'x' < 0 ) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.rindex_neg "hello" 'h' =~ 0 ; Ext_string.rindex_neg "hello" 'e' =~ 1 ; Ext_string.rindex_neg "hello" 'l' =~ 3 ; Ext_string.rindex_neg "hello" 'l' =~ 3 ; Ext_string.rindex_neg "hello" 'o' =~ 4 ; end; - (* __LOC__ >:: begin - fun _ -> - let nl cur s = Ext_string.extract_until s cur '\n' in + (* __LOC__ >:: begin + fun _ -> + let nl cur s = Ext_string.extract_until s cur '\n' in nl (ref 0) "hello\n" =~ "hello"; nl (ref 0) "\nhell" =~ ""; nl (ref 0) "hello" =~ "hello"; - let cur = ref 0 in - let b = "a\nb\nc\nd" in + let cur = ref 0 in + let b = "a\nb\nc\nd" in nl cur b =~ "a"; nl cur b =~ "b"; nl cur b =~ "c"; @@ -16592,7 +16520,7 @@ let suites = nl cur b =~ "" ; nl cur b =~ "" ; cur := 0 ; - let b = "a\nb\nc\nd\n" in + let b = "a\nb\nc\nd\n" in nl cur b =~ "a"; nl cur b =~ "b"; nl cur b =~ "c"; @@ -16600,20 +16528,20 @@ let suites = nl cur b =~ "" ; nl cur b =~ "" ; end ; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> let b = "a\nb\nc\nd\n" in - let a = Ext_string.index_count in + let a = Ext_string.index_count in a b 0 '\n' 1 =~ 1 ; a b 0 '\n' 2 =~ 3; a b 0 '\n' 3 =~ 5; - a b 0 '\n' 4 =~ 7; - a b 0 '\n' 5 =~ -1; + a b 0 '\n' 4 =~ 7; + a b 0 '\n' 5 =~ -1; end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool "empty string" (Ext_string.rindex_neg "" 'x' < 0 ) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (not (Ext_string.for_all_from "xABc"1 (function 'A' .. 'Z' -> true | _ -> false))); @@ -16622,58 +16550,58 @@ let suites = (function 'A' .. 'Z' -> true | _ -> false))); OUnit.assert_bool __LOC__ ( (Ext_string.for_all_from "xABC" 1_000 - (function 'A' .. 'Z' -> true | _ -> false))); - end; + (function 'A' .. 'Z' -> true | _ -> false))); + end; - (* __LOC__ >:: begin fun _ -> + (* __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ @@ List.for_all (fun x -> Ext_string.is_valid_source_name x = Good) - ["x.ml"; "x.mli"; "x.re"; "x.rei"; + ["x.ml"; "x.mli"; "x.re"; "x.rei"; "A_x.ml"; "ab.ml"; "a_.ml"; "a__.ml"; "ax.ml"]; OUnit.assert_bool __LOC__ @@ not @@ List.exists (fun x -> Ext_string.is_valid_source_name x = Good) - [".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~"; - "...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei"; + [".re"; ".rei";"..re"; "..rei"; "..ml"; ".mll~"; + "...ml"; "_.mli"; "_x.ml"; "__.ml"; "__.rei"; ".#hello.ml"; ".#hello.rei"; "a-.ml"; "a-b.ml"; "-a-.ml" ; "-.ml" ] end; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_filename.module_name "a/hello.ml" =~ "Hello"; Ext_filename.as_module ~basename:"a.ml" =~ Some {module_name = "A"; case = false}; Ext_filename.as_module ~basename:"Aa.ml" =~ Some {module_name = "Aa"; case = true}; Ext_filename.as_module ~basename:"_Aa.ml" =~ None; Ext_filename.as_module ~basename:"A_a" =~ Some {module_name = "A_a"; case = true}; Ext_filename.as_module ~basename:"" =~ None; - Ext_filename.as_module ~basename:"a/hello.ml" =~ + Ext_filename.as_module ~basename:"a/hello.ml" =~ None end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ @@ List.for_all Ext_namespace.is_valid_npm_package_name ["x"; "@angualr"; "test"; "hi-x"; "hi-"] ; OUnit.assert_bool __LOC__ @@ - List.for_all + List.for_all (fun x -> not (Ext_namespace.is_valid_npm_package_name x)) ["x "; "x'"; "Test"; "hI"] ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.find ~sub:"hello" "xx hello xx" =~ 3 ; Ext_string.rfind ~sub:"hello" "xx hello xx" =~ 3 ; Ext_string.find ~sub:"hello" "xx hello hello xx" =~ 3 ; Ext_string.rfind ~sub:"hello" "xx hello hello xx" =~ 9 ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.non_overlap_count ~sub:"0" "1000,000" =~ 6; Ext_string.non_overlap_count ~sub:"0" "000000" =~ 6; Ext_string.non_overlap_count ~sub:"00" "000000" =~ 3; Ext_string.non_overlap_count ~sub:"00" "00000" =~ 2 end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "abc"); OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "a"); OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" "b"); @@ -16681,229 +16609,229 @@ let suites = OUnit.assert_bool __LOC__ (Ext_string.contain_substring "abc" ""); OUnit.assert_bool __LOC__ (not @@ Ext_string.contain_substring "abc" "abcc"); end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.trim " \t\n" =~ ""; Ext_string.trim " \t\nb" =~ "b"; Ext_string.trim "b \t\n" =~ "b"; - Ext_string.trim "\t\n b \t\n" =~ "b"; + Ext_string.trim "\t\n b \t\n" =~ "b"; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.starts_with "ab" "a" =~ true; Ext_string.starts_with "ab" "" =~ true; Ext_string.starts_with "abb" "abb" =~ true; Ext_string.starts_with "abb" "abbc" =~ false; end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> string_of_bool x ) in - let k = Ext_string.ends_with in + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> string_of_bool x ) in + let k = Ext_string.ends_with in k "xx.ml" ".ml" =~ true; k "xx.bs.js" ".js" =~ true ; k "xx" ".x" =~false; k "xx" "" =~true - end; - __LOC__ >:: begin fun _ -> + end; + __LOC__ >:: begin fun _ -> Ext_string.ends_with_then_chop "xx.ml" ".ml" =~ Some "xx"; Ext_string.ends_with_then_chop "xx.ml" ".mll" =~ None end; - (* __LOC__ >:: begin fun _ -> + (* __LOC__ >:: begin fun _ -> Ext_string.starts_with_and_number "js_fn_mk_01" ~offset:0 "js_fn_mk_" =~ 1 ; Ext_string.starts_with_and_number "js_fn_run_02" ~offset:0 "js_fn_mk_" =~ -1 ; Ext_string.starts_with_and_number "js_fn_mk_03" ~offset:6 "mk_" =~ 3 ; Ext_string.starts_with_and_number "js_fn_mk_04" ~offset:6 "run_" =~ -1; Ext_string.starts_with_and_number "js_fn_run_04" ~offset:6 "run_" =~ 4; - Ext_string.(starts_with_and_number "js_fn_run_04" ~offset:6 "run_" = 3) =~ false + Ext_string.(starts_with_and_number "js_fn_run_04" ~offset:6 "run_" = 3) =~ false end; *) - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.for_all "____" (function '_' -> true | _ -> false) =~ true; Ext_string.for_all "___-" (function '_' -> true | _ -> false) =~ false; - Ext_string.for_all "" (function '_' -> true | _ -> false) + Ext_string.for_all "" (function '_' -> true | _ -> false) =~ true end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.tail_from "ghsogh" 1 =~ "hsogh"; Ext_string.tail_from "ghsogh" 0 =~ "ghsogh" end; - (* __LOC__ >:: begin fun _ -> - Ext_string.digits_of_str "11_js" ~offset:0 2 =~ 11 + (* __LOC__ >:: begin fun _ -> + Ext_string.digits_of_str "11_js" ~offset:0 2 =~ 11 end; *) - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ - (Ext_string.replace_backward_slash "a:\\b\\d" = + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d" = "a:/b/d" ) ; - OUnit.assert_bool __LOC__ - (Ext_string.replace_backward_slash "a:\\b\\d\\" = + OUnit.assert_bool __LOC__ + (Ext_string.replace_backward_slash "a:\\b\\d\\" = "a:/b/d/" ) ; - OUnit.assert_bool __LOC__ - (Ext_string.replace_slash_backward "a:/b/d/"= - "a:\\b\\d\\" - ) ; - OUnit.assert_bool __LOC__ - (let old = "a:bd" in - Ext_string.replace_backward_slash old == + OUnit.assert_bool __LOC__ + (Ext_string.replace_slash_backward "a:/b/d/"= + "a:\\b\\d\\" + ) ; + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == old ) ; - OUnit.assert_bool __LOC__ - (let old = "a:bd" in - Ext_string.replace_backward_slash old == + OUnit.assert_bool __LOC__ + (let old = "a:bd" in + Ext_string.replace_backward_slash old == old ) ; end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash "ahgoh" ); - OUnit.assert_bool __LOC__ - (Ext_string.no_slash "" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ + (Ext_string.no_slash "" ); + OUnit.assert_bool __LOC__ (not (Ext_string.no_slash "ahgoh/" )); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (not (Ext_string.no_slash "/ahgoh" )); - OUnit.assert_bool __LOC__ - (not (Ext_string.no_slash "/ahgoh/" )); + OUnit.assert_bool __LOC__ + (not (Ext_string.no_slash "/ahgoh/" )); end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ (Ext_string.compare "" "" = 0); OUnit.assert_bool __LOC__ (Ext_string.compare "0" "0" = 0); OUnit.assert_bool __LOC__ (Ext_string.compare "" "acd" < 0); OUnit.assert_bool __LOC__ (Ext_string.compare "acd" "" > 0); - for i = 0 to 256 do - let a = String.init i (fun _ -> '0') in - let b = String.init i (fun _ -> '0') in + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') in OUnit.assert_bool __LOC__ (Ext_string.compare b a = 0); OUnit.assert_bool __LOC__ (Ext_string.compare a b = 0) done ; - for i = 0 to 256 do - let a = String.init i (fun _ -> '0') in - let b = String.init i (fun _ -> '0') ^ "\000"in + for i = 0 to 256 do + let a = String.init i (fun _ -> '0') in + let b = String.init i (fun _ -> '0') ^ "\000"in OUnit.assert_bool __LOC__ (Ext_string.compare a b < 0); OUnit.assert_bool __LOC__ (Ext_string.compare b a > 0) done ; end; - __LOC__ >:: begin fun _ -> - let slow_compare x y = - let x_len = String.length x in - let y_len = String.length y in - if x_len = y_len then - String.compare x y - else - Pervasives.compare x_len y_len in + __LOC__ >:: begin fun _ -> + let slow_compare x y = + let x_len = String.length x in + let y_len = String.length y in + if x_len = y_len then + String.compare x y + else + Pervasives.compare x_len y_len in let same_sign x y = - if x = 0 then y = 0 - else if x < 0 then y < 0 - else y > 0 in + if x = 0 then y = 0 + else if x < 0 then y < 0 + else y > 0 in for i = 0 to 3000 do - let chars = [|'a';'b';'c';'d'|] in - let x = Ounit_data_random.random_string chars 129 in - let y = Ounit_data_random.random_string chars 129 in - let a = Ext_string.compare x y in - let b = slow_compare x y in - if same_sign a b then OUnit.assert_bool __LOC__ true + let chars = [|'a';'b';'c';'d'|] in + let x = Ounit_data_random.random_string chars 129 in + let y = Ounit_data_random.random_string chars 129 in + let a = Ext_string.compare x y in + let b = slow_compare x y in + if same_sign a b then OUnit.assert_bool __LOC__ true else failwith ("incosistent " ^ x ^ " " ^ y ^ " " ^ string_of_int a ^ " " ^ string_of_int b) - done + done end ; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat3 "a0" "a1" "a2") "a0a1a2" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat3 "a0" "a11" "") "a0a11" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat4 "a0" "a1" "a2" "a3") "a0a1a2a3" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.concat4 "a0" "a11" "" "a33") "a0a11a33" - ); + ); end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter2 "a0" "a1") "a0 a1" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter3 "a0" "a1" "a2") "a0 a1 a2" ); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.equal (Ext_string.inter4 "a0" "a1" "a2" "a3") "a0 a1 a2 a3" ); end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "" < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx" < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx/" = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "xxx/g/" = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx "/xxx/g/" = 0) end; - __LOC__ >:: begin fun _ -> - OUnit.assert_bool __LOC__ + __LOC__ >:: begin fun _ -> + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx" 0 < 0); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx/" 1 = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "xxx/g/" 4 = 5); - OUnit.assert_bool __LOC__ - (Ext_string.no_slash_idx_from "xxx/g/" 3 = 3); - OUnit.assert_bool __LOC__ + OUnit.assert_bool __LOC__ + (Ext_string.no_slash_idx_from "xxx/g/" 3 = 3); + OUnit.assert_bool __LOC__ (Ext_string.no_slash_idx_from "/xxx/g/" 0 = 0) end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [||]) Ext_string.empty ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0"|]) "a0" ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"|]) "a0 a1" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2"|]) "a0 a1 a2" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3"|]) "a0 a1 a2 a3" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"a0";"a1"; "a2";"a3";""; "a4"|]) "a0 a1 a2 a3 a4" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"a3";""; "a4"|]) "0 a1 2 a3 a4" - ); + ); OUnit.assert_bool __LOC__ - (Ext_string.equal + (Ext_string.equal (Ext_string.concat_array Ext_string.single_space [|"0";"a1"; "2";"3";"d"; ""; "e"|]) "0 a1 2 3 d e" - ); + ); end; @@ -16911,7 +16839,7 @@ let suites = Ext_namespace.namespace_of_package_name "bs-json" =~ "BsJson" end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_namespace.namespace_of_package_name "xx" =~ "Xx" end; @@ -16926,43 +16854,42 @@ let suites = Ext_namespace.namespace_of_package_name "reason" =~ "Reason"; - Ext_namespace.namespace_of_package_name + Ext_namespace.namespace_of_package_name "@aa/bb" =~"AaBb"; - Ext_namespace.namespace_of_package_name + Ext_namespace.namespace_of_package_name "@A/bb" - =~"ABb" - end; - __LOC__ >:: begin fun _ -> - Ext_namespace.change_ext_ns_suffix "a-b" Literals.suffix_js - =~ "a.js"; - Ext_namespace.change_ext_ns_suffix "a-" Literals.suffix_js - =~ "a.js"; - Ext_namespace.change_ext_ns_suffix "a--" Literals.suffix_js - =~ "a-.js"; - Ext_namespace.change_ext_ns_suffix "AA-b" Literals.suffix_js - =~ "AA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Little_js - =~ "aA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Upper_js - =~ "AA.js"; - Ext_namespace.js_name_of_modulename - "AA-b" Upper_bs - =~ "AA.bs.js"; + =~"ABb" end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> - match x with + __LOC__ >:: begin fun _ -> + Ext_namespace.replace_namespace_with_extension + ~name:"a-b" ~ext:Literals.suffix_js =~ "a.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"a-" ~ext:Literals.suffix_js =~ "a.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"a--" ~ext:Literals.suffix_js =~ "a-.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"AA-b" ~ext:Literals.suffix_js =~ "AA.js"; + Ext_namespace.replace_namespace_with_extension + ~name:"AA-b" ~ext:Literals.suffix_js =~ "AA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_js Lower =~ "aA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_js Upper =~ "AA.js"; + Ext_namespace.js_filename_of_modulename + ~name:"AA-b" ~ext:Literals.suffix_bs_js Upper =~ "AA.bs.js"; + end; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:(fun x -> + match x with | None -> "" | Some (a,b) -> a ^","^ b - ) in + ) in Ext_namespace.try_split_module_name "Js-X" =~ Some ("X","Js"); Ext_namespace.try_split_module_name "Js_X" =~ None end; __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in + let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in let f = Ext_string.capitalize_ascii in f "x" =~ "X"; f "X" =~ "X"; @@ -16973,16 +16900,16 @@ let suites = f v =~ "Bc"; v =~ "bc" end; - __LOC__ >:: begin fun _ -> - let (=~) = OUnit.assert_equal ~printer:printer_string in - Ext_filename.chop_all_extensions_maybe "a.bs.js" =~ "a" ; + __LOC__ >:: begin fun _ -> + let (=~) = OUnit.assert_equal ~printer:printer_string in + Ext_filename.chop_all_extensions_maybe "a.bs.js" =~ "a" ; Ext_filename.chop_all_extensions_maybe "a.js" =~ "a"; Ext_filename.chop_all_extensions_maybe "a" =~ "a"; Ext_filename.chop_all_extensions_maybe "a.x.bs.js" =~ "a" end; (* let (=~) = OUnit.assert_equal ~printer:(fun x -> x) in *) __LOC__ >:: begin fun _ -> - let k = Ext_modulename.js_id_name_of_hint_name in + let k = Ext_modulename.js_id_name_of_hint_name in k "xx" =~ "Xx"; k "react-dom" =~ "ReactDom"; k "a/b/react-dom" =~ "ReactDom"; @@ -16996,29 +16923,29 @@ let suites = k "c/d/a--b"=~ "AB"; k "c/d/ac--" =~ "Ac" end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.capitalize_sub "ab-Ns.cmi" 2 =~ "Ab"; Ext_string.capitalize_sub "Ab-Ns.cmi" 2 =~ "Ab"; Ext_string.capitalize_sub "Ab-Ns.cmi" 3 =~ "Ab-" end ; __LOC__ >:: begin fun _ -> - OUnit.assert_equal - (String.length (Digest.string "")) + OUnit.assert_equal + (String.length (Digest.string "")) Ext_digest.length end; - __LOC__ >:: begin fun _ -> - let bench = String.concat + __LOC__ >:: begin fun _ -> + let bench = String.concat ";" (Ext_list.init 11 (fun i -> string_of_int i)) in - let buf = Ext_buffer.create 10 in + let buf = Ext_buffer.create 10 in OUnit.assert_bool - __LOC__ (Ext_buffer.not_equal buf bench); - for i = 0 to 9 do + __LOC__ (Ext_buffer.not_equal buf bench); + for i = 0 to 9 do Ext_buffer.add_string buf (string_of_int i); Ext_buffer.add_string buf ";" done ; OUnit.assert_bool - __LOC__ (Ext_buffer.not_equal buf bench); + __LOC__ (Ext_buffer.not_equal buf bench); Ext_buffer.add_string buf "10" ; (* print_endline (Ext_buffer.contents buf); print_endline bench; *) @@ -17026,7 +16953,7 @@ let suites = __LOC__ (not (Ext_buffer.not_equal buf bench)) end ; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> string_eq (Ext_filename.new_extension "a.c" ".xx") "a.xx"; string_eq (Ext_filename.new_extension "abb.c" ".xx") "abb.xx"; string_eq (Ext_filename.new_extension ".c" ".xx") ".xx"; @@ -17038,43 +16965,43 @@ let suites = string_eq (Ext_filename.chop_all_extensions_maybe "abx") "abx"; end; __LOC__ >:: begin fun _ -> - string_eq + string_eq (Ext_filename.module_name "a/b/c.d") "C"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.re") "Xc"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.ml") "Xc" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.mli") "Xc" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.cppo.mli") "Xc.cppo"; - string_eq + string_eq (Ext_filename.module_name "a/b/xc.cppo.") "Xc.cppo" ; - string_eq + string_eq (Ext_filename.module_name "a/b/xc..") "Xc." ; - string_eq + string_eq (Ext_filename.module_name "a/b/Xc..") "Xc." ; - string_eq + string_eq (Ext_filename.module_name "a/b/.") - "" ; + "" ; end; - __LOC__ >:: begin fun _ -> + __LOC__ >:: begin fun _ -> Ext_string.split "" ':' =~ []; Ext_string.split "a:b:" ':' =~ ["a";"b"]; Ext_string.split "a:b:" ':' ~keep_empty:true =~ ["a";"b";""] end; - __LOC__ >:: begin fun _ -> - let cmp0 = Ext_string.compare in - let cmp1 = Map_string.compare_key in - let f a b = + __LOC__ >:: begin fun _ -> + let cmp0 = Ext_string.compare in + let cmp1 = Map_string.compare_key in + let f a b = cmp0 a b =~ cmp1 a b ; cmp0 b a =~ cmp1 b a in diff --git a/lib/4.06.1/unstable/bsb_native.ml b/lib/4.06.1/unstable/bsb_native.ml index 6190adf672..be7ab05cfc 100644 --- a/lib/4.06.1/unstable/bsb_native.ml +++ b/lib/4.06.1/unstable/bsb_native.ml @@ -65,7 +65,7 @@ module Bsb_build_schemas = struct #1 "bsb_build_schemas.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -83,7 +83,7 @@ module Bsb_build_schemas * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -141,14 +141,16 @@ let generators = "generators" let command = "command" let edge = "edge" let namespace = "namespace" +let _module = "module" let in_source = "in-source" +let suffix = "suffix" let warnings = "warnings" let number = "number" let error = "error" -let suffix = "suffix" let gentypeconfig = "gentypeconfig" let path = "path" let ignored_dirs = "ignored-dirs" + end module Ext_array : sig #1 "ext_array.mli" @@ -4364,7 +4366,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -4382,7 +4384,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -4392,7 +4394,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -4405,9 +4407,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -4450,7 +4452,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -4460,48 +4462,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -4519,7 +4526,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -4533,7 +4540,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -4592,8 +4599,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -4601,19 +4608,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -4632,9 +4644,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ext_path : sig #1 "ext_path.mli" @@ -5858,344 +5871,208 @@ let () = ) end -module Ext_buffer : sig -#1 "ext_buffer.mli" -(***********************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../LICENSE. *) -(* *) -(***********************************************************************) - -(** Extensible buffers. - - This module implements buffers that automatically expand - as necessary. It provides accumulative concatenation of strings - in quasi-linear time (instead of quadratic time when strings are - concatenated pairwise). -*) +module Ext_color : sig +#1 "ext_color.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* BuckleScript customization: customized for efficient digest *) +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White -type t -(** The abstract type of buffers. *) +type style + = FG of color + | BG of color + | Bold + | Dim -val create : int -> t -(** [create n] returns a fresh buffer, initially empty. - The [n] parameter is the initial size of the internal byte sequence - that holds the buffer contents. That byte sequence is automatically - reallocated when more than [n] characters are stored in the buffer, - but shrinks back to [n] characters when [reset] is called. - For best performance, [n] should be of the same order of magnitude - as the number of characters that are expected to be stored in - the buffer (for instance, 80 for a buffer that holds one output - line). Nothing bad will happen if the buffer grows beyond that - limit, however. In doubt, take [n = 16] for instance. - If [n] is not between 1 and {!Sys.max_string_length}, it will - be clipped to that interval. *) +(** Input is the tag for example `@{@}` return escape code *) +val ansi_of_tag : string -> string -val contents : t -> string -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. *) +val reset_lit : string -val length : t -> int -(** Return the number of characters currently contained in the buffer. *) +end = struct +#1 "ext_color.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val is_empty : t -> bool -val clear : t -> unit -(** Empty the buffer. *) -val add_char : t -> char -> unit -(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) +type color + = Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White -val add_string : t -> string -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) +type style + = FG of color + | BG of color + | Bold + | Dim -val add_bytes : t -> bytes -> unit -(** [add_string b s] appends the string [s] at the end of the buffer [b]. - @since 4.02 *) -val add_substring : t -> string -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in string [s] and appends them at the end of the buffer [b]. *) +let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" -val add_subbytes : t -> bytes -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. - @since 4.02 *) +let code_of_style = function + | FG Black -> "30" + | FG Red -> "31" + | FG Green -> "32" + | FG Yellow -> "33" + | FG Blue -> "34" + | FG Magenta -> "35" + | FG Cyan -> "36" + | FG White -> "37" + + | BG Black -> "40" + | BG Red -> "41" + | BG Green -> "42" + | BG Yellow -> "43" + | BG Blue -> "44" + | BG Magenta -> "45" + | BG Cyan -> "46" + | BG White -> "47" -val add_buffer : t -> t -> unit -(** [add_buffer b1 b2] appends the current contents of buffer [b2] - at the end of buffer [b1]. [b2] is not modified. *) + | Bold -> "1" + | Dim -> "2" -val add_channel : t -> in_channel -> int -> unit -(** [add_channel b ic n] reads exactly [n] character from the - input channel [ic] and stores them at the end of buffer [b]. - Raise [End_of_file] if the channel contains fewer than [n] - characters. *) -val output_buffer : out_channel -> t -> unit -(** [output_buffer oc b] writes the current contents of buffer [b] - on the output channel [oc]. *) -val digest : t -> Digest.t +(** TODO: add more styles later *) +let style_of_tag s = match s with + | "error" -> [Bold; FG Red] + | "warning" -> [Bold; FG Magenta] + | "info" -> [Bold; FG Yellow] + | "dim" -> [Dim] + | "filename" -> [FG Cyan] + | _ -> [] -val not_equal : - t -> - string -> - bool +let ansi_of_tag s = + let l = style_of_tag s in + let s = String.concat ";" (Ext_list.map l code_of_style) in + "\x1b[" ^ s ^ "m" -val add_int_1 : - t -> int -> unit -val add_int_2 : - t -> int -> unit -val add_int_3 : - t -> int -> unit +let reset_lit = "\x1b[0m" -val add_int_4 : - t -> int -> unit -val add_string_char : - t -> - string -> - char -> - unit -val add_char_string : - t -> - char -> - string -> - unit -end = struct -#1 "ext_buffer.ml" -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) -(* Extensible buffers *) -type t = - {mutable buffer : bytes; - mutable position : int; - mutable length : int; - initial_buffer : bytes} - -let create n = - let n = if n < 1 then 1 else n in - - let n = if n > Sys.max_string_length then Sys.max_string_length else n in - - let s = Bytes.create n in - {buffer = s; position = 0; length = n; initial_buffer = s} - -let contents b = Bytes.sub_string b.buffer 0 b.position -let to_bytes b = Bytes.sub b.buffer 0 b.position - -let sub b ofs len = - if ofs < 0 || len < 0 || ofs > b.position - len - then invalid_arg "Ext_buffer.sub" - else Bytes.sub_string b.buffer ofs len - - -let blit src srcoff dst dstoff len = - if len < 0 || srcoff < 0 || srcoff > src.position - len - || dstoff < 0 || dstoff > (Bytes.length dst) - len - then invalid_arg "Ext_buffer.blit" - else - Bytes.unsafe_blit src.buffer srcoff dst dstoff len - -let length b = b.position -let is_empty b = b.position = 0 -let clear b = b.position <- 0 - -let reset b = - b.position <- 0; b.buffer <- b.initial_buffer; - b.length <- Bytes.length b.buffer - -let resize b more = - let len = b.length in - let new_len = ref len in - while b.position + more > !new_len do new_len := 2 * !new_len done; - - if !new_len > Sys.max_string_length then begin - if b.position + more <= Sys.max_string_length - then new_len := Sys.max_string_length - else failwith "Ext_buffer.add: cannot grow buffer" - end; - - let new_buffer = Bytes.create !new_len in - (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in - this tricky function that is slow anyway. *) - Bytes.blit b.buffer 0 new_buffer 0 b.position; - b.buffer <- new_buffer; - b.length <- !new_len ; - assert (b.position + more <= b.length) - -let add_char b c = - let pos = b.position in - if pos >= b.length then resize b 1; - Bytes.unsafe_set b.buffer pos c; - b.position <- pos + 1 - -let add_substring b s offset len = - if offset < 0 || len < 0 || offset > String.length s - len - then invalid_arg "Ext_buffer.add_substring/add_subbytes"; - let new_position = b.position + len in - if new_position > b.length then resize b len; - Ext_bytes.unsafe_blit_string s offset b.buffer b.position len; - b.position <- new_position - - -let add_subbytes b s offset len = - add_substring b (Bytes.unsafe_to_string s) offset len - -let add_string b s = - let len = String.length s in - let new_position = b.position + len in - if new_position > b.length then resize b len; - Ext_bytes.unsafe_blit_string s 0 b.buffer b.position len; - b.position <- new_position - -(* TODO: micro-optimzie *) -let add_string_char b s c = - let s_len = String.length s in - let len = s_len + 1 in - let new_position = b.position + len in - if new_position > b.length then resize b len; - let b_buffer = b.buffer in - Ext_bytes.unsafe_blit_string s 0 b_buffer b.position s_len; - Bytes.unsafe_set b_buffer (new_position - 1) c; - b.position <- new_position - -let add_char_string b c s = - let s_len = String.length s in - let len = s_len + 1 in - let new_position = b.position + len in - if new_position > b.length then resize b len; - let b_buffer = b.buffer in - let b_position = b.position in - Bytes.unsafe_set b_buffer b_position c ; - Ext_bytes.unsafe_blit_string s 0 b_buffer (b_position + 1) s_len; - b.position <- new_position - - -let add_bytes b s = add_string b (Bytes.unsafe_to_string s) - -let add_buffer b bs = - add_subbytes b bs.buffer 0 bs.position - -let add_channel b ic len = - if len < 0 - - || len > Sys.max_string_length - - then (* PR#5004 *) - invalid_arg "Ext_buffer.add_channel"; - if b.position + len > b.length then resize b len; - really_input ic b.buffer b.position len; - b.position <- b.position + len - -let output_buffer oc b = - output oc b.buffer 0 b.position - -external unsafe_string: bytes -> int -> int -> Digest.t = "caml_md5_string" - -let digest b = - unsafe_string - b.buffer 0 b.position - -let rec not_equal_aux (b : bytes) (s : string) i len = - if i >= len then false - else - (Bytes.unsafe_get b i - <> - String.unsafe_get s i ) - || not_equal_aux b s (i + 1) len - -(** avoid a large copy *) -let not_equal (b : t) (s : string) = - let b_len = b.position in - let s_len = String.length s in - b_len <> s_len - || not_equal_aux b.buffer s 0 s_len +end +module Bsb_log : sig +#1 "bsb_log.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - It could be one byte, two bytes, three bytes and four bytes - TODO: inline for better performance -*) -let add_int_1 (b : t ) (x : int ) = - let c = (Char.unsafe_chr (x land 0xff)) in - let pos = b.position in - if pos >= b.length then resize b 1; - Bytes.unsafe_set b.buffer pos c; - b.position <- pos + 1 - -let add_int_2 (b : t ) (x : int ) = - let c1 = (Char.unsafe_chr (x land 0xff)) in - let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in - let pos = b.position in - if pos + 1 >= b.length then resize b 2; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - b.position <- pos + 2 +val setup : unit -> unit -let add_int_3 (b : t ) (x : int ) = - let c1 = (Char.unsafe_chr (x land 0xff)) in - let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in - let c3 = (Char.unsafe_chr (x lsr 16 land 0xff)) in - let pos = b.position in - if pos + 2 >= b.length then resize b 3; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - Bytes.unsafe_set b_buffer (pos + 2) c3; - b.position <- pos + 3 +type level = + | Debug + | Info + | Warn + | Error +val log_level : level ref -let add_int_4 (b : t ) (x : int ) = - let c1 = (Char.unsafe_chr (x land 0xff)) in - let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in - let c3 = (Char.unsafe_chr (x lsr 16 land 0xff)) in - let c4 = (Char.unsafe_chr (x lsr 24 land 0xff)) in - let pos = b.position in - if pos + 3 >= b.length then resize b 4; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - Bytes.unsafe_set b_buffer (pos + 2) c3; - Bytes.unsafe_set b_buffer (pos + 3) c4; - b.position <- pos + 4 +type 'a fmt = Format.formatter -> ('a, Format.formatter, unit) format -> 'a +type 'a log = ('a, Format.formatter, unit) format -> 'a +val verbose : unit -> unit +val debug : 'a log +val info : 'a log +val warn : 'a log +val error : 'a log +val info_args : string array -> unit -end -module Ext_filename : sig -#1 "ext_filename.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. +end = struct +#1 "bsb_log.ml" +(* Copyright (C) 2017- Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -6221,500 +6098,429 @@ module Ext_filename : sig +let ninja_ansi_forced = lazy + (try Sys.getenv "NINJA_ANSI_FORCED" with + Not_found ->"" + ) +let color_enabled = lazy (Unix.isatty Unix.stdout) - -(* TODO: - Change the module name, this code is not really an extension of the standard - library but rather specific to JS Module name convention. -*) +(* same logic as [ninja.exe] *) +let get_color_enabled () = + let colorful = + match ninja_ansi_forced with + | lazy "1" -> true + | lazy ("0" | "false") -> false + | _ -> + Lazy.force color_enabled in + colorful +let color_functions : Format.formatter_tag_functions = { + mark_open_tag = (fun s -> if get_color_enabled () then Ext_color.ansi_of_tag s else Ext_string.empty) ; + mark_close_tag = (fun _ -> if get_color_enabled () then Ext_color.reset_lit else Ext_string.empty); + print_open_tag = (fun _ -> ()); + print_close_tag = (fun _ -> ()) +} +let set_color ppf = + Format.pp_set_formatter_tag_functions ppf color_functions -(** An extension module to calculate relative path follow node/npm style. - TODO : this short name will have to change upon renaming the file. -*) -val is_dir_sep : - char -> bool - -val maybe_quote: - string -> - string +let setup () = + begin + Format.pp_set_mark_tags Format.std_formatter true ; + Format.pp_set_mark_tags Format.err_formatter true; + Format.pp_set_formatter_tag_functions + Format.std_formatter color_functions; + Format.pp_set_formatter_tag_functions + Format.err_formatter color_functions + end -val chop_extension_maybe: - string -> - string +type level = + | Debug + | Info + | Warn + | Error -(* return an empty string if no extension found *) -val get_extension_maybe: - string -> - string +let int_of_level (x : level) = + match x with + | Debug -> 0 + | Info -> 1 + | Warn -> 2 + | Error -> 3 +let log_level = ref Warn -val new_extension: - string -> - string -> - string +let verbose () = + log_level := Debug +let dfprintf level fmt = + if int_of_level level >= int_of_level !log_level then + Format.fprintf fmt + else Format.ifprintf fmt -val chop_all_extensions_maybe: - string -> - string +type 'a fmt = + Format.formatter -> ('a, Format.formatter, unit) format -> 'a +type 'a log = + ('a, Format.formatter, unit) format -> 'a -(* OCaml specific abstraction*) -val module_name: - string -> - string +let debug fmt = dfprintf Debug Format.std_formatter fmt +let info fmt = dfprintf Info Format.std_formatter fmt +let warn fmt = dfprintf Warn Format.err_formatter fmt +let error fmt = dfprintf Error Format.err_formatter fmt +let info_args (args : string array) = + if int_of_level Info >= int_of_level !log_level then + begin + for i = 0 to Array.length args - 1 do + Format.pp_print_string Format.std_formatter (Array.unsafe_get args i) ; + Format.pp_print_string Format.std_formatter Ext_string.single_space; + done ; + Format.pp_print_newline Format.std_formatter () + end + else () + +end +module Ext_buffer : sig +#1 "ext_buffer.mli" +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../LICENSE. *) +(* *) +(***********************************************************************) -type module_info = { - module_name : string ; - case : bool; -} +(** Extensible buffers. + This module implements buffers that automatically expand + as necessary. It provides accumulative concatenation of strings + in quasi-linear time (instead of quadratic time when strings are + concatenated pairwise). +*) +(* BuckleScript customization: customized for efficient digest *) -val as_module: - basename:string -> - module_info option -end = struct -#1 "ext_filename.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type t +(** The abstract type of buffers. *) +val create : int -> t +(** [create n] returns a fresh buffer, initially empty. + The [n] parameter is the initial size of the internal byte sequence + that holds the buffer contents. That byte sequence is automatically + reallocated when more than [n] characters are stored in the buffer, + but shrinks back to [n] characters when [reset] is called. + For best performance, [n] should be of the same order of magnitude + as the number of characters that are expected to be stored in + the buffer (for instance, 80 for a buffer that holds one output + line). Nothing bad will happen if the buffer grows beyond that + limit, however. In doubt, take [n = 16] for instance. + If [n] is not between 1 and {!Sys.max_string_length}, it will + be clipped to that interval. *) +val contents : t -> string +(** Return a copy of the current contents of the buffer. + The buffer itself is unchanged. *) +val length : t -> int +(** Return the number of characters currently contained in the buffer. *) -let is_dir_sep_unix c = c = '/' -let is_dir_sep_win_cygwin c = - c = '/' || c = '\\' || c = ':' +val is_empty : t -> bool -let is_dir_sep = - if Sys.unix then is_dir_sep_unix else is_dir_sep_win_cygwin +val clear : t -> unit +(** Empty the buffer. *) -(* reference ninja.cc IsKnownShellSafeCharacter *) -let maybe_quote ( s : string) = - let noneed_quote = - Ext_string.for_all s (function - | '0' .. '9' - | 'a' .. 'z' - | 'A' .. 'Z' - | '_' | '+' - | '-' | '.' - | '/' - | '@' -> true - | _ -> false - ) in - if noneed_quote then - s - else Filename.quote s +val add_char : t -> char -> unit +(** [add_char b c] appends the character [c] at the end of the buffer [b]. *) -let chop_extension_maybe name = - let rec search_dot i = - if i < 0 || is_dir_sep (String.unsafe_get name i) then name - else if String.unsafe_get name i = '.' then String.sub name 0 i - else search_dot (i - 1) in - search_dot (String.length name - 1) +val add_string : t -> string -> unit +(** [add_string b s] appends the string [s] at the end of the buffer [b]. *) -let get_extension_maybe name = - let name_len = String.length name in - let rec search_dot name i name_len = - if i < 0 || is_dir_sep (String.unsafe_get name i) then "" - else if String.unsafe_get name i = '.' then String.sub name i (name_len - i) - else search_dot name (i - 1) name_len in - search_dot name (name_len - 1) name_len +val add_bytes : t -> bytes -> unit +(** [add_string b s] appends the string [s] at the end of the buffer [b]. + @since 4.02 *) -let chop_all_extensions_maybe name = - let rec search_dot i last = - if i < 0 || is_dir_sep (String.unsafe_get name i) then - (match last with - | None -> name - | Some i -> String.sub name 0 i) - else if String.unsafe_get name i = '.' then - search_dot (i - 1) (Some i) - else search_dot (i - 1) last in - search_dot (String.length name - 1) None +val add_substring : t -> string -> int -> int -> unit +(** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in string [s] and appends them at the end of the buffer [b]. *) +val add_subbytes : t -> bytes -> int -> int -> unit +(** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in byte sequence [s] and appends them at the end of the buffer [b]. + @since 4.02 *) -let new_extension name (ext : string) = - let rec search_dot name i ext = - if i < 0 || is_dir_sep (String.unsafe_get name i) then - name ^ ext - else if String.unsafe_get name i = '.' then - let ext_len = String.length ext in - let buf = Bytes.create (i + ext_len) in - Bytes.blit_string name 0 buf 0 i; - Bytes.blit_string ext 0 buf i ext_len; - Bytes.unsafe_to_string buf - else search_dot name (i - 1) ext in - search_dot name (String.length name - 1) ext +val add_buffer : t -> t -> unit +(** [add_buffer b1 b2] appends the current contents of buffer [b2] + at the end of buffer [b1]. [b2] is not modified. *) +val add_channel : t -> in_channel -> int -> unit +(** [add_channel b ic n] reads exactly [n] character from the + input channel [ic] and stores them at the end of buffer [b]. + Raise [End_of_file] if the channel contains fewer than [n] + characters. *) +val output_buffer : out_channel -> t -> unit +(** [output_buffer oc b] writes the current contents of buffer [b] + on the output channel [oc]. *) -(** TODO: improve efficiency - given a path, calcuate its module name - Note that `ocamlc.opt -c aa.xx.mli` gives `aa.xx.cmi` - we can not strip all extensions, otherwise - we can not tell the difference between "x.cpp.ml" - and "x.ml" -*) -let module_name name = - let rec search_dot i name = - if i < 0 then - Ext_string.capitalize_ascii name - else - if String.unsafe_get name i = '.' then - Ext_string.capitalize_sub name i - else - search_dot (i - 1) name in - let name = Filename.basename name in - let name_len = String.length name in - search_dot (name_len - 1) name +val digest : t -> Digest.t -type module_info = { - module_name : string ; - case : bool; -} +val not_equal : + t -> + string -> + bool +val add_int_1 : + t -> int -> unit +val add_int_2 : + t -> int -> unit -let rec valid_module_name_aux name off len = - if off >= len then true - else - let c = String.unsafe_get name off in - match c with - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> - valid_module_name_aux name (off + 1) len - | _ -> false +val add_int_3 : + t -> int -> unit -type state = - | Invalid - | Upper - | Lower +val add_int_4 : + t -> int -> unit -let valid_module_name name len = - if len = 0 then Invalid - else - let c = String.unsafe_get name 0 in - match c with - | 'A' .. 'Z' - -> - if valid_module_name_aux name 1 len then - Upper - else Invalid - | 'a' .. 'z' - -> - if valid_module_name_aux name 1 len then - Lower - else Invalid - | _ -> Invalid +val add_string_char : + t -> + string -> + char -> + unit +val add_char_string : + t -> + char -> + string -> + unit +end = struct +#1 "ext_buffer.ml" +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1999 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) -let as_module ~basename = - let rec search_dot i name name_len = - if i < 0 then - (* Input e.g, [a_b] *) - match valid_module_name name name_len with - | Invalid -> None - | Upper -> Some {module_name = name; case = true } - | Lower -> Some {module_name = Ext_string.capitalize_ascii name; case = false} - else - if String.unsafe_get name i = '.' then - (*Input e.g, [A_b] *) - match valid_module_name name i with - | Invalid -> None - | Upper -> - Some {module_name = Ext_string.capitalize_sub name i; case = true} - | Lower -> - Some {module_name = Ext_string.capitalize_sub name i; case = false} - else - search_dot (i - 1) name name_len in - let name_len = String.length basename in - search_dot (name_len - 1) basename name_len - -end -module Ext_namespace : sig -#1 "ext_namespace.mli" -(* Copyright (C) 2017- Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* Extensible buffers *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string +type t = + {mutable buffer : bytes; + mutable position : int; + mutable length : int; + initial_buffer : bytes} -val try_split_module_name : - string -> (string * string ) option +let create n = + let n = if n < 1 then 1 else n in + + let n = if n > Sys.max_string_length then Sys.max_string_length else n in + + let s = Bytes.create n in + {buffer = s; position = 0; length = n; initial_buffer = s} +let contents b = Bytes.sub_string b.buffer 0 b.position +let to_bytes b = Bytes.sub b.buffer 0 b.position +let sub b ofs len = + if ofs < 0 || len < 0 || ofs > b.position - len + then invalid_arg "Ext_buffer.sub" + else Bytes.sub_string b.buffer ofs len -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - #1933 when removing ns suffix, don't pass the bound - of basename -*) -val change_ext_ns_suffix : - string -> - string -> - string +let blit src srcoff dst dstoff len = + if len < 0 || srcoff < 0 || srcoff > src.position - len + || dstoff < 0 || dstoff > (Bytes.length dst) - len + then invalid_arg "Ext_buffer.blit" + else + Bytes.unsafe_blit src.buffer srcoff dst dstoff len -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +let length b = b.position +let is_empty b = b.position = 0 +let clear b = b.position <- 0 -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +let reset b = + b.position <- 0; b.buffer <- b.initial_buffer; + b.length <- Bytes.length b.buffer -val namespace_of_package_name : string -> string +let resize b more = + let len = b.length in + let new_len = ref len in + while b.position + more > !new_len do new_len := 2 * !new_len done; + + if !new_len > Sys.max_string_length then begin + if b.position + more <= Sys.max_string_length + then new_len := Sys.max_string_length + else failwith "Ext_buffer.add: cannot grow buffer" + end; + + let new_buffer = Bytes.create !new_len in + (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in + this tricky function that is slow anyway. *) + Bytes.blit b.buffer 0 new_buffer 0 b.position; + b.buffer <- new_buffer; + b.length <- !new_len ; + assert (b.position + more <= b.length) -end = struct -#1 "ext_namespace.ml" +let add_char b c = + let pos = b.position in + if pos >= b.length then resize b 1; + Bytes.unsafe_set b.buffer pos c; + b.position <- pos + 1 -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let add_substring b s offset len = + if offset < 0 || len < 0 || offset > String.length s - len + then invalid_arg "Ext_buffer.add_substring/add_subbytes"; + let new_position = b.position + len in + if new_position > b.length then resize b len; + Ext_bytes.unsafe_blit_string s offset b.buffer b.position len; + b.position <- new_position -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) -let ns_sep_char = '-' -let ns_sep = "-" +let add_subbytes b s offset len = + add_substring b (Bytes.unsafe_to_string s) offset len -let make ?ns cunit = - match ns with - | None -> cunit - | Some ns -> cunit ^ ns_sep ^ ns +let add_string b s = + let len = String.length s in + let new_position = b.position + len in + if new_position > b.length then resize b len; + Ext_bytes.unsafe_blit_string s 0 b.buffer b.position len; + b.position <- new_position +(* TODO: micro-optimzie *) +let add_string_char b s c = + let s_len = String.length s in + let len = s_len + 1 in + let new_position = b.position + len in + if new_position > b.length then resize b len; + let b_buffer = b.buffer in + Ext_bytes.unsafe_blit_string s 0 b_buffer b.position s_len; + Bytes.unsafe_set b_buffer (new_position - 1) c; + b.position <- new_position -let rec rindex_rec s i = - if i < 0 then i else - let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) +let add_char_string b c s = + let s_len = String.length s in + let len = s_len + 1 in + let new_position = b.position + len in + if new_position > b.length then resize b len; + let b_buffer = b.buffer in + let b_position = b.position in + Bytes.unsafe_set b_buffer b_position c ; + Ext_bytes.unsafe_blit_string s 0 b_buffer (b_position + 1) s_len; + b.position <- new_position -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +let add_bytes b s = add_string b (Bytes.unsafe_to_string s) +let add_buffer b bs = + add_subbytes b bs.buffer 0 bs.position - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false +let add_channel b ic len = + if len < 0 + || len > Sys.max_string_length -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = - if off >= len then () + then (* PR#5004 *) + invalid_arg "Ext_buffer.add_channel"; + if b.position + len > b.length then resize b len; + really_input ic b.buffer b.position len; + b.position <- b.position + len + +let output_buffer oc b = + output oc b.buffer 0 b.position + +external unsafe_string: bytes -> int -> int -> Digest.t = "caml_md5_string" + +let digest b = + unsafe_string + b.buffer 0 b.position + +let rec not_equal_aux (b : bytes) (s : string) i len = + if i >= len then false else - let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + (Bytes.unsafe_get b i + <> + String.unsafe_get s i ) + || not_equal_aux b s (i + 1) len -end -module Bsb_package_specs : sig -#1 "bsb_package_specs.mli" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** avoid a large copy *) +let not_equal (b : t) (s : string) = + let b_len = b.position in + let s_len = String.length s in + b_len <> s_len + || not_equal_aux b.buffer s 0 s_len -type t + +(** + It could be one byte, two bytes, three bytes and four bytes + TODO: inline for better performance +*) +let add_int_1 (b : t ) (x : int ) = + let c = (Char.unsafe_chr (x land 0xff)) in + let pos = b.position in + if pos >= b.length then resize b 1; + Bytes.unsafe_set b.buffer pos c; + b.position <- pos + 1 + +let add_int_2 (b : t ) (x : int ) = + let c1 = (Char.unsafe_chr (x land 0xff)) in + let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in + let pos = b.position in + if pos + 1 >= b.length then resize b 2; + let b_buffer = b.buffer in + Bytes.unsafe_set b_buffer pos c1; + Bytes.unsafe_set b_buffer (pos + 1) c2; + b.position <- pos + 2 + +let add_int_3 (b : t ) (x : int ) = + let c1 = (Char.unsafe_chr (x land 0xff)) in + let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in + let c3 = (Char.unsafe_chr (x lsr 16 land 0xff)) in + let pos = b.position in + if pos + 2 >= b.length then resize b 3; + let b_buffer = b.buffer in + Bytes.unsafe_set b_buffer pos c1; + Bytes.unsafe_set b_buffer (pos + 1) c2; + Bytes.unsafe_set b_buffer (pos + 2) c3; + b.position <- pos + 3 -val default_package_specs : t +let add_int_4 (b : t ) (x : int ) = + let c1 = (Char.unsafe_chr (x land 0xff)) in + let c2 = (Char.unsafe_chr (x lsr 8 land 0xff)) in + let c3 = (Char.unsafe_chr (x lsr 16 land 0xff)) in + let c4 = (Char.unsafe_chr (x lsr 24 land 0xff)) in + let pos = b.position in + if pos + 3 >= b.length then resize b 4; + let b_buffer = b.buffer in + Bytes.unsafe_set b_buffer pos c1; + Bytes.unsafe_set b_buffer (pos + 1) c2; + Bytes.unsafe_set b_buffer (pos + 2) c3; + Bytes.unsafe_set b_buffer (pos + 3) c4; + b.position <- pos + 4 -val from_json: - Ext_json_types.t -> t -val get_list_of_output_js : - t -> bool -> string -> string list -(** - Sample output: {[ -bs-package-output commonjs:lib/js/jscomp/test]} -*) -val package_flag_of_package_specs : - t -> string -> string -val list_dirs_by : - t -> - (string -> unit) -> - unit -end = struct -#1 "bsb_package_specs.ml" -(* Copyright (C) 2017 Authors of BuckleScript +end +module Ext_filename : sig +#1 "ext_filename.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -6739,164 +6545,70 @@ end = struct * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - -(* TODO: sync up with {!Js_packages_info.module_system} *) -type format = - | NodeJS | Es6 | Es6_global -type spec = { - format : format; - in_source : bool -} +(* TODO: + Change the module name, this code is not really an extension of the standard + library but rather specific to JS Module name convention. +*) -module Spec_set = Set.Make( struct type t = spec - let compare = Pervasives.compare - end) -type t = Spec_set.t -let bad_module_format_message_exn ~loc format = - Bsb_exception.errorf ~loc "package-specs: `%s` isn't a valid output module format. It has to be one of: %s, %s or %s" - format - Literals.commonjs - Literals.es6 - Literals.es6_global -let supported_format (x : string) loc = - if x = Literals.commonjs then NodeJS - else if x = Literals.es6 then Es6 - else if x = Literals.es6_global then Es6_global - else bad_module_format_message_exn ~loc x +(** An extension module to calculate relative path follow node/npm style. + TODO : this short name will have to change upon renaming the file. +*) -let string_of_format (x : format) = - match x with - | NodeJS -> Literals.commonjs - | Es6 -> Literals.es6 - | Es6_global -> Literals.es6_global +val is_dir_sep : + char -> bool + +val maybe_quote: + string -> + string -let prefix_of_format (x : format) = - (match x with - | NodeJS -> Bsb_config.lib_js - | Es6 -> Bsb_config.lib_es6 - | Es6_global -> Bsb_config.lib_es6_global ) +val chop_extension_maybe: + string -> + string -let rec from_array (arr : Ext_json_types.t array) : Spec_set.t = - let spec = ref Spec_set.empty in - let has_in_source = ref false in - Ext_array.iter arr (fun x -> - let result = from_json_single x in - if result.in_source then - ( - if not !has_in_source then - has_in_source:= true - else - Bsb_exception.errorf - ~loc:(Ext_json.loc_of x) - "package-specs: we've detected two module formats that are both configured to be in-source." - ); - spec := Spec_set.add result !spec - ); - !spec +(* return an empty string if no extension found *) +val get_extension_maybe: + string -> + string -(* TODO: FIXME: better API without mutating *) -and from_json_single (x : Ext_json_types.t) : spec = - match x with - | Str {str = format; loc } -> - {format = supported_format format loc ; in_source = false } - | Obj {map; loc} -> - begin match Map_string.find_exn map "module" with - | Str {str = format} -> - let in_source = - match Map_string.find_opt map Bsb_build_schemas.in_source with - | Some (True _) -> true - | Some _ - | None -> false - in - {format = supported_format format loc ; in_source } - | Arr _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, `module` field should be a string, not an array. If you want to pass multiple module specs, try turning package-specs into an array of objects (or strings) instead." - | _ -> - Bsb_exception.errorf ~loc - "package-specs: the `module` field of the configuration object should be a string." - | exception _ -> - Bsb_exception.errorf ~loc - "package-specs: when the configuration is an object, the `module` field is mandatory." - end - | _ -> Bsb_exception.errorf ~loc:(Ext_json.loc_of x) - "package-specs: we expect either a string or an object." -let from_json (x : Ext_json_types.t) : Spec_set.t = - match x with - | Arr {content ; _} -> from_array content - | _ -> Spec_set.singleton (from_json_single x ) +val new_extension: + string -> + string -> + string +val chop_all_extensions_maybe: + string -> + string -let bs_package_output = "-bs-package-output" +(* OCaml specific abstraction*) +val module_name: + string -> + string -(** Assume input is valid - {[ -bs-package-output commonjs:lib/js/jscomp/test ]} -*) -let package_flag ({format; in_source } : spec) dir = - Ext_string.inter2 - bs_package_output - (Ext_string.concat3 - (string_of_format format) - Ext_string.single_colon - (if in_source then dir else - prefix_of_format format // dir)) -let package_flag_of_package_specs (package_specs : t) - (dirname : string ) : string = - Spec_set.fold (fun format acc -> - Ext_string.inter2 acc (package_flag format dirname ) - ) package_specs Ext_string.empty -let default_package_specs = - Spec_set.singleton - { format = NodeJS ; in_source = false } +type module_info = { + module_name : string ; + case : bool; +} -(** - [get_list_of_output_js specs "src/hi/hello"] -*) -let get_list_of_output_js - (package_specs : Spec_set.t) - (bs_suffix : bool) - (output_file_sans_extension : string) - = - Spec_set.fold - (fun (spec : spec) acc -> - let basename = Ext_namespace.change_ext_ns_suffix - output_file_sans_extension - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) - in - (Bsb_config.proj_rel @@ (if spec.in_source then basename - else prefix_of_format spec.format // basename)) - :: acc - ) package_specs [] - - -let list_dirs_by - (package_specs : Spec_set.t) - (f : string -> unit) - = - Spec_set.iter (fun (spec : spec) -> - if not spec.in_source then - f (prefix_of_format spec.format) - ) package_specs -end -module Bsc_warnings -= struct -#1 "bsc_warnings.ml" -(* Copyright (C) 2020- Authors of BuckleScript - * +val as_module: + basename:string -> + module_info option +end = struct +#1 "ext_filename.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -6913,38 +6625,167 @@ module Bsc_warnings * This program 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 Lesser General Public License for more details. + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - See the meanings of the warning codes here: https://caml.inria.fr/pub/docs/manual-ocaml/comp.html#sec281 - - 30 Two labels or constructors of the same name are defined in two mutually recursive types. - - 40 Constructor or label name used out of scope. +let is_dir_sep_unix c = c = '/' +let is_dir_sep_win_cygwin c = + c = '/' || c = '\\' || c = ':' - - 6 Label omitted in function application. - - 7 Method overridden. - - 9 Missing fields in a record pattern. (*Not always desired, in some cases need [@@@warning "+9"] *) - - 27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn’t start with an underscore (_) character. - - 29 Unescaped end-of-line in a string constant (non-portable code). - - 32 .. 39 Unused blabla - - 44 Open statement shadows an already defined identifier. - - 45 Open statement shadows an already defined label or constructor. - - 48 Implicit elimination of optional arguments. https://caml.inria.fr/mantis/view.php?id=6352 - - 101 (bsb-specific) unsafe polymorphic comparison. -*) -let defaults_w = "-30-40+6+7+27+32..39+44+45+101" -let defaults_warn_error = "-a+5+101";; +let is_dir_sep = + if Sys.unix then is_dir_sep_unix else is_dir_sep_win_cygwin + +(* reference ninja.cc IsKnownShellSafeCharacter *) +let maybe_quote ( s : string) = + let noneed_quote = + Ext_string.for_all s (function + | '0' .. '9' + | 'a' .. 'z' + | 'A' .. 'Z' + | '_' | '+' + | '-' | '.' + | '/' + | '@' -> true + | _ -> false + ) in + if noneed_quote then + s + else Filename.quote s + + +let chop_extension_maybe name = + let rec search_dot i = + if i < 0 || is_dir_sep (String.unsafe_get name i) then name + else if String.unsafe_get name i = '.' then String.sub name 0 i + else search_dot (i - 1) in + search_dot (String.length name - 1) + +let get_extension_maybe name = + let name_len = String.length name in + let rec search_dot name i name_len = + if i < 0 || is_dir_sep (String.unsafe_get name i) then "" + else if String.unsafe_get name i = '.' then String.sub name i (name_len - i) + else search_dot name (i - 1) name_len in + search_dot name (name_len - 1) name_len + +let chop_all_extensions_maybe name = + let rec search_dot i last = + if i < 0 || is_dir_sep (String.unsafe_get name i) then + (match last with + | None -> name + | Some i -> String.sub name 0 i) + else if String.unsafe_get name i = '.' then + search_dot (i - 1) (Some i) + else search_dot (i - 1) last in + search_dot (String.length name - 1) None + + +let new_extension name (ext : string) = + let rec search_dot name i ext = + if i < 0 || is_dir_sep (String.unsafe_get name i) then + name ^ ext + else if String.unsafe_get name i = '.' then + let ext_len = String.length ext in + let buf = Bytes.create (i + ext_len) in + Bytes.blit_string name 0 buf 0 i; + Bytes.blit_string ext 0 buf i ext_len; + Bytes.unsafe_to_string buf + else search_dot name (i - 1) ext in + search_dot name (String.length name - 1) ext + + + +(** TODO: improve efficiency + given a path, calcuate its module name + Note that `ocamlc.opt -c aa.xx.mli` gives `aa.xx.cmi` + we can not strip all extensions, otherwise + we can not tell the difference between "x.cpp.ml" + and "x.ml" +*) +let module_name name = + let rec search_dot i name = + if i < 0 then + Ext_string.capitalize_ascii name + else + if String.unsafe_get name i = '.' then + Ext_string.capitalize_sub name i + else + search_dot (i - 1) name in + let name = Filename.basename name in + let name_len = String.length name in + search_dot (name_len - 1) name + +type module_info = { + module_name : string ; + case : bool; +} + + + +let rec valid_module_name_aux name off len = + if off >= len then true + else + let c = String.unsafe_get name off in + match c with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> + valid_module_name_aux name (off + 1) len + | _ -> false + +type state = + | Invalid + | Upper + | Lower + +let valid_module_name name len = + if len = 0 then Invalid + else + let c = String.unsafe_get name 0 in + match c with + | 'A' .. 'Z' + -> + if valid_module_name_aux name 1 len then + Upper + else Invalid + | 'a' .. 'z' + -> + if valid_module_name_aux name 1 len then + Lower + else Invalid + | _ -> Invalid + +let as_module ~basename = + let rec search_dot i name name_len = + if i < 0 then + (* Input e.g, [a_b] *) + match valid_module_name name name_len with + | Invalid -> None + | Upper -> Some {module_name = name; case = true } + | Lower -> Some {module_name = Ext_string.capitalize_ascii name; case = false} + else + if String.unsafe_get name i = '.' then + (*Input e.g, [A_b] *) + match valid_module_name name i with + | Invalid -> None + | Upper -> + Some {module_name = Ext_string.capitalize_sub name i; case = true} + | Lower -> + Some {module_name = Ext_string.capitalize_sub name i; case = false} + else + search_dot (i - 1) name name_len in + let name_len = String.length basename in + search_dot (name_len - 1) basename name_len + end -module Bsb_warning : sig -#1 "bsb_warning.mli" -(* Copyright (C) 2017 Authors of BuckleScript +module Ext_namespace : sig +#1 "ext_namespace.mli" +(* Copyright (C) 2017- Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -6968,29 +6809,32 @@ module Bsb_warning : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. +*) -type t - -(** Extra work is need to make merlin happy *) -val to_merlin_string : t -> string - +type leading_case = Upper | Lower +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) -val from_map : Ext_json_types.t Map_string.t -> t +val is_valid_npm_package_name : string -> bool -(** [to_bsb_string not_dev warning] -*) -val to_bsb_string : - toplevel:bool -> - t -> - string +val namespace_of_package_name : string -> string -val use_default : t end = struct -#1 "bsb_warning.ml" -(* Copyright (C) 2017 Authors of BuckleScript +#1 "ext_namespace.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -7014,120 +6858,117 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) +let ns_sep_char = '-' +let ns_sep = "-" -type warning_error = - | Warn_error_false - (* default [false] to make our changes non-intrusive *) - | Warn_error_true - | Warn_error_number of string - -type t0 = { - number : string option; - error : warning_error -} - -type nonrec t = t0 option - -let use_default = None +let make ?ns cunit = + match ns with + | None -> cunit + | Some ns -> cunit ^ ns_sep ^ ns -let prepare_warning_concat ~(beg : bool) s = - let s = Ext_string.trim s in - if s = "" then s - else - match s.[0] with - | '0' .. '9' -> if beg then "-w +" ^ s else "+" ^ s - | 'a' .. 'z' -> - if beg then "-w " ^ s else "+" ^ s - | _ -> - if beg then "-w " ^ s else s -let to_merlin_string x = - "-w " ^ Bsc_warnings.defaults_w - ^ - (match x with - | Some {number =None} - | None -> Ext_string.empty - | Some {number = Some x} -> - prepare_warning_concat ~beg:false x ) +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else + let char = String.unsafe_get s i in + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) - -let from_map (m : Ext_json_types.t Map_string.t) = - let number_opt = Map_string.find_opt m Bsb_build_schemas.number in - let error_opt = Map_string.find_opt m Bsb_build_schemas.error in - match number_opt, error_opt with - | None, None -> None - | _, _ -> - let error = - match error_opt with - | Some (True _) -> Warn_error_true - | Some (False _) -> Warn_error_false - | Some (Str {str ; }) - -> Warn_error_number str - | Some x -> Bsb_exception.config_error x "expect true/false or string" - | None -> Warn_error_false - (** To make it less intrusive : warning error has to be enabled*) - in - let number = - match number_opt with - | Some (Str { str = number}) -> Some number - | None -> None - | Some x -> Bsb_exception.config_error x "expect a string" - in - Some {number; error } +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 -let to_bsb_string ~toplevel warning = - match warning with - | None -> Ext_string.empty - | Some warning -> - (match warning.number with - | None -> - Ext_string.empty - | Some x -> - prepare_warning_concat ~beg:true x - ) ^ - if toplevel then - match warning.error with - | Warn_error_true -> - " -warn-error A" - | Warn_error_number y -> - " -warn-error " ^ y - | Warn_error_false -> - Ext_string.empty - else Ext_string.empty + #1933 when removing ns suffix, don't pass the bound of basename + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext -end -module Bs_hash_stubs -= struct -#1 "bs_hash_stubs.ml" +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) -external hash_string : string -> int = "caml_bs_hash_string" [@@noalloc];; -external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" [@@noalloc];; +type leading_case = Upper | Lower -external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" [@@noalloc];; +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext -external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" [@@noalloc];; -external hash_small_int : int -> int = "caml_bs_hash_small_int" [@@noalloc];; +(** https://docs.npmjs.com/files/package.json -external hash_int : int -> int = "caml_bs_hash_int" [@@noalloc];; + Some rules: -external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. -external - int_unsafe_blit : - int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; + TODO: handle cases like '\@angular/core'. its directory structure is like: - + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = + if off >= len then () + else + let ch = String.unsafe_get s off in + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end -module Ext_util : sig -#1 "ext_util.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +module Bsb_package_specs : sig +#1 "bsb_package_specs.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7145,21 +6986,32 @@ module Ext_util : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type t - -val power_2_above : int -> int -> int +val default_package_specs : ?deprecated_bs_suffix:bool -> unit -> t +val from_json : ?deprecated_bs_suffix:bool -> Ext_json_types.t -> t + +val get_list_of_output_js : t -> string -> string list + +val extract_in_source_bs_suffixes : t -> string list + +val flags_of_package_specs : t -> string -> string +(** Sample output: + + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) + +val list_dirs_by : t -> (string -> unit) -> unit -val stats_to_string : Hashtbl.statistics -> string end = struct -#1 "ext_util.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +#1 "bsb_package_specs.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7177,220 +7029,300 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - {[ - (power_2_above 16 63 = 64) - (power_2_above 16 76 = 128) - ]} -*) -let rec power_2_above x n = - if x >= n then x - else if x * 2 > Sys.max_array_length then x - else power_2_above (x * 2) n +let ( // ) = Ext_path.combine +(* TODO: sync up with {!Js_package_info.module_system} *) +type format = NodeJS | Es6 | Es6_global -let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = - Printf.sprintf - "bindings: %d,buckets: %d, longest: %d, hist:[%s]" - num_bindings - num_buckets - max_bucket_length - (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) -end -module Hash_set_gen -= struct -#1 "hash_set_gen.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type spec = { format : format; in_source : bool; suffix : string } +module Spec_set = Set.Make (struct + type t = spec + let compare = Pervasives.compare +end) -(* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. *) +type t = Spec_set.t -type 'a bucket = - | Empty - | Cons of { - mutable key : 'a ; - mutable next : 'a bucket - } +let bad_module_format_message_exn ~loc format = + Bsb_exception.errorf ~loc + "package-specs: `%s` isn't a valid output module format. It has to be one \ + of: %s, %s or %s" + format Literals.commonjs Literals.es6 Literals.es6_global -type 'a t = - { mutable size: int; (* number of entries *) - mutable data: 'a bucket array; (* the buckets *) - initial_size: int; (* initial array size *) - } + +let supported_format (x : string) loc = + if x = Literals.commonjs then NodeJS + else if x = Literals.es6 then Es6 + else if x = Literals.es6_global then Es6_global + else bad_module_format_message_exn ~loc x + + +let string_of_format (x : format) = + match x with + | NodeJS -> Literals.commonjs + | Es6 -> Literals.es6 + | Es6_global -> Literals.es6_global +let prefix_of_format (x : format) = + match x with + | NodeJS -> Bsb_config.lib_js + | Es6 -> Bsb_config.lib_es6 + | Es6_global -> Bsb_config.lib_es6_global + + +let deprecated_bs_suffix_message_warn () = + Bsb_log.warn + "@{DEPRECATED@}: @[top-level 'suffix' field is deprecated;@ \ + please lower your extension-configuration into@ 'package-specs'.@]@." + + +let bad_suffix_message_warn suffix = + let open Literals in + Bsb_log.warn + "@{UNSUPPORTED@}: @[package-specs: extension `%s` is \ + unsupported;@ consider one of: %s, %s, %s; %s, %s,@ or %s.@]@." + suffix suffix_js suffix_mjs suffix_cjs suffix_bs_js suffix_bs_mjs + suffix_bs_cjs + + +let supported_suffix (x : string) = + if + not + (List.mem x + Literals. + [ + suffix_js; + suffix_mjs; + suffix_cjs; + suffix_bs_js; + suffix_bs_mjs; + suffix_bs_cjs; + ]) + then bad_suffix_message_warn x; + x -let create initial_size = - let s = Ext_util.power_2_above 16 initial_size in - { initial_size = s; size = 0; data = Array.make s Empty } +let default_suffix ~deprecated_bs_suffix _format _in_source = + (* match (format, in_source) with *) + (* | NodeJS, false -> Literals.suffix_js *) + (* | NodeJS, true -> Literals.suffix_bs_js *) + (* | _, false -> Literals.suffix_mjs *) + (* | _, true -> Literals.suffix_bs_mjs *) -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - Array.unsafe_set h.data i Empty - done + (* TODO: In the absence of direction to the contrary, the suffix should + eventually depend on [format] and [in_source]. For now, for + backwards-compatibility, I'm hardcoding. *) + if deprecated_bs_suffix then Literals.suffix_bs_js else Literals.suffix_js + + +module SS = Set.Make (String) + +let supported_bs_suffixes = + Literals.[ suffix_bs_js; suffix_bs_mjs; suffix_bs_cjs ] + + +(** Produces a [list] of supported, bs-prefixed file-suffixes used in + [in-source] package-specs. *) +let extract_in_source_bs_suffixes (package_specs : Spec_set.t) = + let f spec suffixes = + if spec.in_source && List.mem spec.suffix supported_bs_suffixes then + SS.add spec.suffix suffixes + else suffixes + in + let suffixes = Spec_set.fold f package_specs SS.empty in + SS.elements suffixes + + +let rec from_array ~deprecated_bs_suffix (arr : Ext_json_types.t array) : + Spec_set.t = + let specs = ref Spec_set.empty in + Ext_array.iter arr (fun x -> + let spec = from_json_single ~deprecated_bs_suffix x in + if + Spec_set.exists + (fun o -> + spec.in_source == o.in_source && String.equal spec.suffix o.suffix) + !specs + then + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: two conflicting module formats with the extension \ + `%s` are both configured to be in-source." + spec.suffix + else specs := Spec_set.add spec !specs); + !specs + + +(* FIXME: better API without mutating *) +and from_json_single ~deprecated_bs_suffix (x : Ext_json_types.t) : spec = + match x with + | Str { str = format; loc } -> + let format = supported_format format loc in + { + format; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix format false; + } + | Obj { map; loc } -> ( + match Map_string.find_exn map Bsb_build_schemas._module with + | Str { str = format } -> + let format = supported_format format loc in + let in_source = + match Map_string.find_opt map Bsb_build_schemas.in_source with + | Some (True _) -> true + | Some _ | None -> false + in + let suffix = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | Some (Str { str = suffix; loc }) -> supported_suffix suffix + | Some _ -> + Bsb_exception.errorf ~loc + "package-specs: the `suffix` field of the configuration \ + object must be absent, or a string." + | None -> default_suffix ~deprecated_bs_suffix format in_source + in + { format; in_source; suffix } + | Arr _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, `module` \ + field should be a string, not an array. If you want to pass \ + multiple module specs, try turning package-specs into an array of \ + objects (or strings) instead." + | _ -> + Bsb_exception.errorf ~loc + "package-specs: the `module` field of the configuration object \ + should be a string." + | exception _ -> + Bsb_exception.errorf ~loc + "package-specs: when the configuration is an object, the `module` \ + field is mandatory." ) + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of x) + "package-specs: we expect either a string or an object." -let reset h = - h.size <- 0; - h.data <- Array.make h.initial_size Empty -let length h = h.size +let from_json ?(deprecated_bs_suffix = false) (x : Ext_json_types.t) : + Spec_set.t = + if deprecated_bs_suffix then deprecated_bs_suffix_message_warn (); + match x with + | Arr { content; _ } -> from_array ~deprecated_bs_suffix content + | _ -> Spec_set.singleton (from_json_single ~deprecated_bs_suffix x) -let resize indexfun h = - let odata = h.data in - let osize = Array.length odata in - let nsize = osize * 2 in - if nsize < Sys.max_array_length then begin - let ndata = Array.make nsize Empty in - let ndata_tail = Array.make nsize Empty in - h.data <- ndata; (* so that indexfun sees the new bucket count *) - let rec insert_bucket = function - Empty -> () - | Cons {key; next} as cell -> - let nidx = indexfun h key in - begin match Array.unsafe_get ndata_tail nidx with - | Empty -> - Array.unsafe_set ndata nidx cell - | Cons tail -> - tail.next <- cell - end; - Array.unsafe_set ndata_tail nidx cell; - insert_bucket next - in - for i = 0 to osize - 1 do - insert_bucket (Array.unsafe_get odata i) - done; - for i = 0 to nsize - 1 do - match Array.unsafe_get ndata_tail i with - | Empty -> () - | Cons tail -> tail.next <- Empty - done - end -let iter h f = - let rec do_bucket = function - | Empty -> - () - | Cons l -> - f l.key ; do_bucket l.next in - let d = h.data in - for i = 0 to Array.length d - 1 do - do_bucket (Array.unsafe_get d i) - done +let bs_package_output = "-bs-package-output" -let fold h init f = - let rec do_bucket b accu = - match b with - Empty -> - accu - | Cons l -> - do_bucket l.next (f l.key accu) in - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket (Array.unsafe_get d i) !accu - done; - !accu +(** Assume input is valid + {[ -bs-package-output commonjs:lib/js/jscomp/test:mjs ]} *) +let package_flag ({ format; in_source; suffix } : spec) dir = + Ext_string.inter2 bs_package_output + (Ext_string.concat5 (string_of_format format) Ext_string.single_colon + (if in_source then dir else prefix_of_format format // dir) + Ext_string.single_colon suffix) -let elements set = - fold set [] List.cons + +let flags_of_package_specs (package_specs : t) (dirname : string) : string = + Spec_set.fold + (fun format acc -> Ext_string.inter2 acc (package_flag format dirname)) + package_specs Ext_string.empty +let default_package_specs ?deprecated_bs_suffix () = + let deprecated_bs_suffix = match deprecated_bs_suffix with + | Some x -> deprecated_bs_suffix_message_warn (); x + | None -> false + in + Spec_set.singleton + { + format = NodeJS; + in_source = false; + suffix = default_suffix ~deprecated_bs_suffix NodeJS false; + } -let rec small_bucket_mem eq key lst = - match lst with - | Empty -> false - | Cons lst -> - eq key lst.key || - match lst.next with - | Empty -> false - | Cons lst -> - eq key lst.key || - match lst.next with - | Empty -> false - | Cons lst -> - eq key lst.key || - small_bucket_mem eq key lst.next +(** [get_list_of_output_js specs true "src/hi/hello"] *) +let get_list_of_output_js (package_specs : Spec_set.t) + (output_file_sans_extension : string) = + Spec_set.fold + (fun spec acc -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:output_file_sans_extension ~ext:spec.suffix + in + ( Bsb_config.proj_rel + @@ + if spec.in_source then basename + else prefix_of_format spec.format // basename ) + :: acc) + package_specs [] -let rec remove_bucket - (h : _ t) (i : int) - key - ~(prec : _ bucket) - (buck : _ bucket) - eq_key = - match buck with - | Empty -> - () - | Cons {key=k; next } -> - if eq_key k key - then begin - h.size <- h.size - 1; - match prec with - | Empty -> Array.unsafe_set h.data i next - | Cons c -> c.next <- next - end - else remove_bucket h i key ~prec:buck next eq_key +let list_dirs_by (package_specs : Spec_set.t) (f : string -> unit) = + Spec_set.iter + (fun (spec : spec) -> + if not spec.in_source then f (prefix_of_format spec.format)) + package_specs -module type S = -sig - type key - type t - val create: int -> t - val clear : t -> unit - val reset : t -> unit - (* val copy: t -> t *) - val remove: t -> key -> unit - val add : t -> key -> unit - val of_array : key array -> t - val check_add : t -> key -> bool - val mem : t -> key -> bool - val iter: t -> (key -> unit) -> unit - val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b - val length: t -> int - (* val stats: t -> Hashtbl.statistics *) - val elements : t -> key list end +module Bsc_warnings += struct +#1 "bsc_warnings.ml" +(* Copyright (C) 2020- Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 + + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +(** + See the meanings of the warning codes here: https://caml.inria.fr/pub/docs/manual-ocaml/comp.html#sec281 + + - 30 Two labels or constructors of the same name are defined in two mutually recursive types. + - 40 Constructor or label name used out of scope. + + - 6 Label omitted in function application. + - 7 Method overridden. + - 9 Missing fields in a record pattern. (*Not always desired, in some cases need [@@@warning "+9"] *) + - 27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn’t start with an underscore (_) character. + - 29 Unescaped end-of-line in a string constant (non-portable code). + - 32 .. 39 Unused blabla + - 44 Open statement shadows an already defined identifier. + - 45 Open statement shadows an already defined label or constructor. + - 48 Implicit elimination of optional arguments. https://caml.inria.fr/mantis/view.php?id=6352 + - 101 (bsb-specific) unsafe polymorphic comparison. +*) +let defaults_w = "-30-40+6+7+27+32..39+44+45+101" +let defaults_warn_error = "-a+5+101";; end -module Hash_set_string : sig -#1 "hash_set_string.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +module Bsb_warning : sig +#1 "bsb_warning.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7408,19 +7340,35 @@ module Hash_set_string : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -include Hash_set_gen.S with type key = string + +type t + +(** Extra work is need to make merlin happy *) +val to_merlin_string : t -> string + + + +val from_map : Ext_json_types.t Map_string.t -> t + +(** [to_bsb_string not_dev warning] +*) +val to_bsb_string : + toplevel:bool -> + t -> + string + +val use_default : t end = struct -#1 "hash_set_string.ml" -# 1 "ext/hash_set.cppo.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +#1 "bsb_warning.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7438,83 +7386,125 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -# 31 "ext/hash_set.cppo.ml" -type key = string -let key_index (h : _ Hash_set_gen.t ) (key : key) = - (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) -let eq_key = Ext_string.equal -type t = key Hash_set_gen.t -# 64 "ext/hash_set.cppo.ml" -let create = Hash_set_gen.create -let clear = Hash_set_gen.clear -let reset = Hash_set_gen.reset -(* let copy = Hash_set_gen.copy *) -let iter = Hash_set_gen.iter -let fold = Hash_set_gen.fold -let length = Hash_set_gen.length -(* let stats = Hash_set_gen.stats *) -let elements = Hash_set_gen.elements +type warning_error = + | Warn_error_false + (* default [false] to make our changes non-intrusive *) + | Warn_error_true + | Warn_error_number of string + +type t0 = { + number : string option; + error : warning_error +} + +type nonrec t = t0 option + +let use_default = None + +let prepare_warning_concat ~(beg : bool) s = + let s = Ext_string.trim s in + if s = "" then s + else + match s.[0] with + | '0' .. '9' -> if beg then "-w +" ^ s else "+" ^ s + | 'a' .. 'z' -> + if beg then "-w " ^ s else "+" ^ s + | _ -> + if beg then "-w " ^ s else s + +let to_merlin_string x = + "-w " ^ Bsc_warnings.defaults_w + ^ + (match x with + | Some {number =None} + | None -> Ext_string.empty + | Some {number = Some x} -> + prepare_warning_concat ~beg:false x ) + + + +let from_map (m : Ext_json_types.t Map_string.t) = + let number_opt = Map_string.find_opt m Bsb_build_schemas.number in + let error_opt = Map_string.find_opt m Bsb_build_schemas.error in + match number_opt, error_opt with + | None, None -> None + | _, _ -> + let error = + match error_opt with + | Some (True _) -> Warn_error_true + | Some (False _) -> Warn_error_false + | Some (Str {str ; }) + -> Warn_error_number str + | Some x -> Bsb_exception.config_error x "expect true/false or string" + | None -> Warn_error_false + (** To make it less intrusive : warning error has to be enabled*) + in + let number = + match number_opt with + | Some (Str { str = number}) -> Some number + | None -> None + | Some x -> Bsb_exception.config_error x "expect a string" + in + Some {number; error } + +let to_bsb_string ~toplevel warning = + match warning with + | None -> Ext_string.empty + | Some warning -> + (match warning.number with + | None -> + Ext_string.empty + | Some x -> + prepare_warning_concat ~beg:true x + ) ^ + if toplevel then + match warning.error with + | Warn_error_true -> + " -warn-error A" + | Warn_error_number y -> + " -warn-error " ^ y + | Warn_error_false -> + Ext_string.empty + else Ext_string.empty + +end +module Bs_hash_stubs += struct +#1 "bs_hash_stubs.ml" -let remove (h : _ Hash_set_gen.t ) key = - let i = key_index h key in - let h_data = h.data in - Hash_set_gen.remove_bucket h i key ~prec:Empty (Array.unsafe_get h_data i) eq_key +external hash_string : string -> int = "caml_bs_hash_string" [@@noalloc];; +external hash_string_int : string -> int -> int = "caml_bs_hash_string_and_int" [@@noalloc];; +external hash_string_small_int : string -> int -> int = "caml_bs_hash_string_and_small_int" [@@noalloc];; -let add (h : _ Hash_set_gen.t) key = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (Cons {key = key ; next = old_bucket}); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h - end +external hash_stamp_and_name : int -> string -> int = "caml_bs_hash_stamp_and_name" [@@noalloc];; -let of_array arr = - let len = Array.length arr in - let tbl = create len in - for i = 0 to len - 1 do - add tbl (Array.unsafe_get arr i); - done ; - tbl - - -let check_add (h : _ Hash_set_gen.t) key : bool = - let i = key_index h key in - let h_data = h.data in - let old_bucket = (Array.unsafe_get h_data i) in - if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then - begin - Array.unsafe_set h_data i (Cons { key = key ; next = old_bucket}); - h.size <- h.size + 1 ; - if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h; - true - end - else false +external hash_small_int : int -> int = "caml_bs_hash_small_int" [@@noalloc];; +external hash_int : int -> int = "caml_bs_hash_int" [@@noalloc];; -let mem (h : _ Hash_set_gen.t) key = - Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) +external string_length_based_compare : string -> string -> int = "caml_string_length_based_compare" [@@noalloc];; - +external + int_unsafe_blit : + int array -> int -> int array -> int -> int -> unit = "caml_int_array_blit" [@@noalloc];; + + end -module Bsb_config_types -= struct -#1 "bsb_config_types.ml" +module Ext_util : sig +#1 "ext_util.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7532,76 +7522,19 @@ module Bsb_config_types * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type dependency = - { - package_name : Bsb_pkg_types.t ; - package_install_path : string ; - } -type dependencies = dependency list - -(* `string` is a path to the entrypoint *) -type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string - -type compilation_kind_t = Js | Bytecode | Native - -type reason_react_jsx = - | Jsx_v2 - | Jsx_v3 - (* string option *) - -type refmt = string option - -type gentype_config = { - path : string (* resolved *) -} -type command = string + +val power_2_above : int -> int -> int -type ppx = { - name : string; - args : string list -} -type t = - { - package_name : string ; - (* [captial-package] *) - namespace : string option; - (* CapitalPackage *) - external_includes : string list ; - bsc_flags : string list ; - ppx_files : ppx list ; - pp_file : string option; - bs_dependencies : dependencies; - bs_dev_dependencies : dependencies; - built_in_dependency : dependency option; - warning : Bsb_warning.t; - (*TODO: maybe we should always resolve bs-platform - so that we can calculate correct relative path in - [.merlin] - *) - refmt : refmt; - js_post_build_cmd : string option; - package_specs : Bsb_package_specs.t ; - file_groups : Bsb_file_groups.t; - files_to_install : Hash_set_string.t ; - generate_merlin : bool ; - reason_react_jsx : reason_react_jsx option; (* whether apply PPX transform or not*) - entries : entries_t list ; - generators : command Map_string.t ; - cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) - bs_suffix : bool ; (* true means [.bs.js] we should pass [-bs-suffix] flag *) - gentype_config : gentype_config option; - number_of_dev_groups : int - } -end -module Ext_color : sig -#1 "ext_color.mli" +val stats_to_string : Hashtbl.statistics -> string +end = struct +#1 "ext_util.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -7626,29 +7559,29 @@ module Ext_color : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type color - = Black - | Red - | Green - | Yellow - | Blue - | Magenta - | Cyan - | White - -type style - = FG of color - | BG of color - | Bold - | Dim - -(** Input is the tag for example `@{@}` return escape code *) -val ansi_of_tag : string -> string +(** + {[ + (power_2_above 16 63 = 64) + (power_2_above 16 76 = 128) + ]} +*) +let rec power_2_above x n = + if x >= n then x + else if x * 2 > Sys.max_array_length then x + else power_2_above (x * 2) n -val reset_lit : string -end = struct -#1 "ext_color.ml" +let stats_to_string ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : Hashtbl.statistics) = + Printf.sprintf + "bindings: %d,buckets: %d, longest: %d, hist:[%s]" + num_bindings + num_buckets + max_bucket_length + (String.concat "," (Array.to_list (Array.map string_of_int bucket_histogram))) +end +module Hash_set_gen += struct +#1 "hash_set_gen.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify @@ -7674,85 +7607,166 @@ end = struct * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) +type 'a bucket = + | Empty + | Cons of { + mutable key : 'a ; + mutable next : 'a bucket + } -type color - = Black - | Red - | Green - | Yellow - | Blue - | Magenta - | Cyan - | White +type 'a t = + { mutable size: int; (* number of entries *) + mutable data: 'a bucket array; (* the buckets *) + initial_size: int; (* initial array size *) + } -type style - = FG of color - | BG of color - | Bold - | Dim -let ansi_of_color = function - | Black -> "0" - | Red -> "1" - | Green -> "2" - | Yellow -> "3" - | Blue -> "4" - | Magenta -> "5" - | Cyan -> "6" - | White -> "7" -let code_of_style = function - | FG Black -> "30" - | FG Red -> "31" - | FG Green -> "32" - | FG Yellow -> "33" - | FG Blue -> "34" - | FG Magenta -> "35" - | FG Cyan -> "36" - | FG White -> "37" - - | BG Black -> "40" - | BG Red -> "41" - | BG Green -> "42" - | BG Yellow -> "43" - | BG Blue -> "44" - | BG Magenta -> "45" - | BG Cyan -> "46" - | BG White -> "47" +let create initial_size = + let s = Ext_util.power_2_above 16 initial_size in + { initial_size = s; size = 0; data = Array.make s Empty } + +let clear h = + h.size <- 0; + let len = Array.length h.data in + for i = 0 to len - 1 do + Array.unsafe_set h.data i Empty + done + +let reset h = + h.size <- 0; + h.data <- Array.make h.initial_size Empty + +let length h = h.size + +let resize indexfun h = + let odata = h.data in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize < Sys.max_array_length then begin + let ndata = Array.make nsize Empty in + let ndata_tail = Array.make nsize Empty in + h.data <- ndata; (* so that indexfun sees the new bucket count *) + let rec insert_bucket = function + Empty -> () + | Cons {key; next} as cell -> + let nidx = indexfun h key in + begin match Array.unsafe_get ndata_tail nidx with + | Empty -> + Array.unsafe_set ndata nidx cell + | Cons tail -> + tail.next <- cell + end; + Array.unsafe_set ndata_tail nidx cell; + insert_bucket next + in + for i = 0 to osize - 1 do + insert_bucket (Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match Array.unsafe_get ndata_tail i with + | Empty -> () + | Cons tail -> tail.next <- Empty + done + end + +let iter h f = + let rec do_bucket = function + | Empty -> + () + | Cons l -> + f l.key ; do_bucket l.next in + let d = h.data in + for i = 0 to Array.length d - 1 do + do_bucket (Array.unsafe_get d i) + done - | Bold -> "1" - | Dim -> "2" +let fold h init f = + let rec do_bucket b accu = + match b with + Empty -> + accu + | Cons l -> + do_bucket l.next (f l.key accu) in + let d = h.data in + let accu = ref init in + for i = 0 to Array.length d - 1 do + accu := do_bucket (Array.unsafe_get d i) !accu + done; + !accu +let elements set = + fold set [] List.cons -(** TODO: add more styles later *) -let style_of_tag s = match s with - | "error" -> [Bold; FG Red] - | "warning" -> [Bold; FG Magenta] - | "info" -> [Bold; FG Yellow] - | "dim" -> [Dim] - | "filename" -> [FG Cyan] - | _ -> [] -let ansi_of_tag s = - let l = style_of_tag s in - let s = String.concat ";" (Ext_list.map l code_of_style) in - "\x1b[" ^ s ^ "m" +let rec small_bucket_mem eq key lst = + match lst with + | Empty -> false + | Cons lst -> + eq key lst.key || + match lst.next with + | Empty -> false + | Cons lst -> + eq key lst.key || + match lst.next with + | Empty -> false + | Cons lst -> + eq key lst.key || + small_bucket_mem eq key lst.next -let reset_lit = "\x1b[0m" +let rec remove_bucket + (h : _ t) (i : int) + key + ~(prec : _ bucket) + (buck : _ bucket) + eq_key = + match buck with + | Empty -> + () + | Cons {key=k; next } -> + if eq_key k key + then begin + h.size <- h.size - 1; + match prec with + | Empty -> Array.unsafe_set h.data i next + | Cons c -> c.next <- next + end + else remove_bucket h i key ~prec:buck next eq_key +module type S = +sig + type key + type t + val create: int -> t + val clear : t -> unit + val reset : t -> unit + (* val copy: t -> t *) + val remove: t -> key -> unit + val add : t -> key -> unit + val of_array : key array -> t + val check_add : t -> key -> bool + val mem : t -> key -> bool + val iter: t -> (key -> unit) -> unit + val fold: t -> 'b -> (key -> 'b -> 'b) -> 'b + val length: t -> int + (* val stats: t -> Hashtbl.statistics *) + val elements : t -> key list +end end -module Bsb_log : sig -#1 "bsb_log.mli" -(* Copyright (C) 2017 Authors of BuckleScript +module Hash_set_string : sig +#1 "hash_set_string.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -7777,31 +7791,12 @@ module Bsb_log : sig * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val setup : unit -> unit - -type level = - | Debug - | Info - | Warn - | Error - -val log_level : level ref - -type 'a fmt = Format.formatter -> ('a, Format.formatter, unit) format -> 'a - -type 'a log = ('a, Format.formatter, unit) format -> 'a - -val verbose : unit -> unit -val debug : 'a log -val info : 'a log -val warn : 'a log -val error : 'a log - -val info_args : string array -> unit +include Hash_set_gen.S with type key = string end = struct -#1 "bsb_log.ml" -(* Copyright (C) 2017- Authors of BuckleScript +#1 "hash_set_string.ml" +# 1 "ext/hash_set.cppo.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -7824,92 +7819,161 @@ end = struct * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +# 31 "ext/hash_set.cppo.ml" +type key = string +let key_index (h : _ Hash_set_gen.t ) (key : key) = + (Bs_hash_stubs.hash_string key) land (Array.length h.data - 1) +let eq_key = Ext_string.equal +type t = key Hash_set_gen.t +# 64 "ext/hash_set.cppo.ml" +let create = Hash_set_gen.create +let clear = Hash_set_gen.clear +let reset = Hash_set_gen.reset +(* let copy = Hash_set_gen.copy *) +let iter = Hash_set_gen.iter +let fold = Hash_set_gen.fold +let length = Hash_set_gen.length +(* let stats = Hash_set_gen.stats *) +let elements = Hash_set_gen.elements -let ninja_ansi_forced = lazy - (try Sys.getenv "NINJA_ANSI_FORCED" with - Not_found ->"" - ) -let color_enabled = lazy (Unix.isatty Unix.stdout) -(* same logic as [ninja.exe] *) -let get_color_enabled () = - let colorful = - match ninja_ansi_forced with - | lazy "1" -> true - | lazy ("0" | "false") -> false - | _ -> - Lazy.force color_enabled in - colorful +let remove (h : _ Hash_set_gen.t ) key = + let i = key_index h key in + let h_data = h.data in + Hash_set_gen.remove_bucket h i key ~prec:Empty (Array.unsafe_get h_data i) eq_key -let color_functions : Format.formatter_tag_functions = { - mark_open_tag = (fun s -> if get_color_enabled () then Ext_color.ansi_of_tag s else Ext_string.empty) ; - mark_close_tag = (fun _ -> if get_color_enabled () then Ext_color.reset_lit else Ext_string.empty); - print_open_tag = (fun _ -> ()); - print_close_tag = (fun _ -> ()) -} -let set_color ppf = - Format.pp_set_formatter_tag_functions ppf color_functions +let add (h : _ Hash_set_gen.t) key = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (Cons {key = key ; next = old_bucket}); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h + end + +let of_array arr = + let len = Array.length arr in + let tbl = create len in + for i = 0 to len - 1 do + add tbl (Array.unsafe_get arr i); + done ; + tbl + + +let check_add (h : _ Hash_set_gen.t) key : bool = + let i = key_index h key in + let h_data = h.data in + let old_bucket = (Array.unsafe_get h_data i) in + if not (Hash_set_gen.small_bucket_mem eq_key key old_bucket) then + begin + Array.unsafe_set h_data i (Cons { key = key ; next = old_bucket}); + h.size <- h.size + 1 ; + if h.size > Array.length h_data lsl 1 then Hash_set_gen.resize key_index h; + true + end + else false -let setup () = - begin - Format.pp_set_mark_tags Format.std_formatter true ; - Format.pp_set_mark_tags Format.err_formatter true; - Format.pp_set_formatter_tag_functions - Format.std_formatter color_functions; - Format.pp_set_formatter_tag_functions - Format.err_formatter color_functions - end +let mem (h : _ Hash_set_gen.t) key = + Hash_set_gen.small_bucket_mem eq_key key (Array.unsafe_get h.data (key_index h key)) + + -type level = - | Debug - | Info - | Warn - | Error +end +module Bsb_config_types += struct +#1 "bsb_config_types.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let int_of_level (x : level) = - match x with - | Debug -> 0 - | Info -> 1 - | Warn -> 2 - | Error -> 3 -let log_level = ref Warn +type dependency = + { + package_name : Bsb_pkg_types.t ; + package_install_path : string ; + } +type dependencies = dependency list -let verbose () = - log_level := Debug -let dfprintf level fmt = - if int_of_level level >= int_of_level !log_level then - Format.fprintf fmt - else Format.ifprintf fmt +(* `string` is a path to the entrypoint *) +type entries_t = JsTarget of string | NativeTarget of string | BytecodeTarget of string -type 'a fmt = - Format.formatter -> ('a, Format.formatter, unit) format -> 'a -type 'a log = - ('a, Format.formatter, unit) format -> 'a +type compilation_kind_t = Js | Bytecode | Native -let debug fmt = dfprintf Debug Format.std_formatter fmt -let info fmt = dfprintf Info Format.std_formatter fmt -let warn fmt = dfprintf Warn Format.err_formatter fmt -let error fmt = dfprintf Error Format.err_formatter fmt +type reason_react_jsx = + | Jsx_v2 + | Jsx_v3 + (* string option *) +type refmt = string option -let info_args (args : string array) = - if int_of_level Info >= int_of_level !log_level then - begin - for i = 0 to Array.length args - 1 do - Format.pp_print_string Format.std_formatter (Array.unsafe_get args i) ; - Format.pp_print_string Format.std_formatter Ext_string.single_space; - done ; - Format.pp_print_newline Format.std_formatter () - end - else () - +type gentype_config = { + path : string (* resolved *) +} +type command = string + +type ppx = { + name : string; + args : string list +} +type t = + { + package_name : string ; + (* [captial-package] *) + namespace : string option; + (* CapitalPackage *) + external_includes : string list ; + bsc_flags : string list ; + ppx_files : ppx list ; + pp_file : string option; + bs_dependencies : dependencies; + bs_dev_dependencies : dependencies; + built_in_dependency : dependency option; + warning : Bsb_warning.t; + (*TODO: maybe we should always resolve bs-platform + so that we can calculate correct relative path in + [.merlin] + *) + refmt : refmt; + js_post_build_cmd : string option; + package_specs : Bsb_package_specs.t ; + file_groups : Bsb_file_groups.t; + files_to_install : Hash_set_string.t ; + generate_merlin : bool ; + reason_react_jsx : reason_react_jsx option; (* whether apply PPX transform or not*) + entries : entries_t list ; + generators : command Map_string.t ; + cut_generators : bool; (* note when used as a dev mode, we will always ignore it *) + gentype_config : gentype_config option; + number_of_dev_groups : int + } end module Bsb_real_path : sig @@ -10246,7 +10310,7 @@ end module Bsb_parse_sources : sig #1 "bsb_parse_sources.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -10264,39 +10328,31 @@ module Bsb_parse_sources : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** [scan .. cxt json] - entry is to the [sources] in the schema - given a root, return an object which is - all relative paths, this function will do the IO -*) val scan : - toplevel: bool -> - root: string -> - cut_generators: bool -> - namespace : string option -> - bs_suffix:bool -> + toplevel:bool -> + root:string -> + cut_generators:bool -> + namespace:string option -> + bs_suffixes:string list -> ignored_dirs:Set_string.t -> - Ext_json_types.t -> - Bsb_file_groups.t * int + Ext_json_types.t -> + Bsb_file_groups.t * int +(** [scan .. cxt json] entry is to the [sources] in the schema given a root, + return an object which is all relative paths, this function will do the IO *) + +val clean_re_js : string -> unit +(** This function has some duplication from [scan], the parsing assuming the + format is already valid *) -(** This function has some duplication - from [scan], - the parsing assuming the format is - already valid -*) -val clean_re_js: - string -> unit end = struct #1 "bsb_parse_sources.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -10314,491 +10370,501 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type build_generator = Bsb_file_groups.build_generator - - type file_group = Bsb_file_groups.file_group -type t = Bsb_file_groups.t +type t = Bsb_file_groups.t -let is_input_or_output (xs : build_generator list) (x : string) = - Ext_list.exists xs (fun {input; output} -> - let it_is = fun y -> y = x in - Ext_list.exists input it_is || - Ext_list.exists output it_is - ) +let is_input_or_output (xs : build_generator list) (x : string) = + Ext_list.exists xs (fun { input; output } -> + let it_is y = y = x in + Ext_list.exists input it_is || Ext_list.exists output it_is) -let errorf x fmt = - Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt +let errorf x fmt = Bsb_exception.errorf ~loc:(Ext_json.loc_of x) fmt type cxt = { - toplevel : bool ; - dir_index : Bsb_dir_index.t ; - cwd : string ; + toplevel : bool; + dir_index : Bsb_dir_index.t; + cwd : string; root : string; cut_generators : bool; traverse : bool; namespace : string option; - bs_suffix: bool; - ignored_dirs : Set_string.t + bs_suffixes : string list; + ignored_dirs : Set_string.t; } -(** [public] has a list of modules, we do a sanity check to see if all the listed - modules are indeed valid module components -*) -let collect_pub_modules - (xs : Ext_json_types.t array) - (cache : Bsb_db.t) : Set_string.t = - let set = ref Set_string.empty in - for i = 0 to Array.length xs - 1 do - let v = Array.unsafe_get xs i in - match v with - | Str { str} - -> - if Map_string.mem cache str then - set := Set_string.add !set str - else - Bsb_log.warn - "@{IGNORED@} %S in public is ignored since it is not\ - an existing module@." str - | _ -> - Bsb_exception.errorf - ~loc:(Ext_json.loc_of v) - "public excpect a list of strings" - done ; +(* [public] has a list of modules, we do a sanity check to see if all the listed + modules are indeed valid module components *) +let collect_pub_modules (xs : Ext_json_types.t array) (cache : Bsb_db.t) : + Set_string.t = + let set = ref Set_string.empty in + for i = 0 to Array.length xs - 1 do + let v = Array.unsafe_get xs i in + match v with + | Str { str } -> + if Map_string.mem cache str then set := Set_string.add !set str + else + Bsb_log.warn + "@{IGNORED@} %S in public is ignored since it is notan \ + existing module@." + str + | _ -> + Bsb_exception.errorf ~loc:(Ext_json.loc_of v) + "public excpect a list of strings" + done; !set -let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) : Bsb_file_groups.public = - match Map_string.find_opt input Bsb_build_schemas.public with - | Some ((Str({str = s}) as x)) -> - if s = Bsb_build_schemas.export_all then Export_all else - if s = Bsb_build_schemas.export_none then Export_none else - errorf x "invalid str for %s " s - | Some (Arr {content = s}) -> - Export_set (collect_pub_modules s cur_sources) - | Some config -> - Bsb_exception.config_error config "expect array or string" - | None -> - Export_all -let extract_resources (input : Ext_json_types.t Map_string.t) : string list = - match Map_string.find_opt input Bsb_build_schemas.resources with - | Some (Arr x) -> - Bsb_build_util.get_list_string x.content - | Some config -> - Bsb_exception.config_error config - "expect array " - | None -> [] +let extract_pub (input : Ext_json_types.t Map_string.t) (cur_sources : Bsb_db.t) + : Bsb_file_groups.public = + match Map_string.find_opt input Bsb_build_schemas.public with + | Some (Str { str = s } as x) -> + if s = Bsb_build_schemas.export_all then Export_all + else if s = Bsb_build_schemas.export_none then Export_none + else errorf x "invalid str for %s " s + | Some (Arr { content = s }) -> Export_set (collect_pub_modules s cur_sources) + | Some config -> Bsb_exception.config_error config "expect array or string" + | None -> Export_all + + +let extract_resources (input : Ext_json_types.t Map_string.t) : string list = + match Map_string.find_opt input Bsb_build_schemas.resources with + | Some (Arr x) -> Bsb_build_util.get_list_string x.content + | Some config -> Bsb_exception.config_error config "expect array " + | None -> [] -let extract_input_output (edge : Ext_json_types.t) : string list * string list = - let error () = +let extract_input_output (edge : Ext_json_types.t) : string list * string list = + let error () = errorf edge {| invalid edge format, expect ["output" , ":", "input" ]|} - in - match edge with - | Arr {content} -> - (match Ext_array.find_and_split content - (fun x () -> match x with Str { str =":"} -> true | _ -> false ) - () with - | `No_split -> error () - | `Split ( output, input) -> - (Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str } -> - Some str - | _ -> None) output - , - Ext_array.to_list_map (fun (x : Ext_json_types.t) -> - match x with - | Str {str = ":"} -> - error () - | Str {str} -> - Some str (* More rigirous error checking: It would trigger a ninja syntax error *) - | _ -> None) input)) - | _ -> error () + in + match edge with + | Arr { content } -> ( + match + Ext_array.find_and_split content + (fun x () -> + match x with + | Str { str = ":" } -> true + | _ -> false) + () + with + | `No_split -> error () + | `Split (output, input) -> + ( Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> Some str + | _ -> None) + output, + Ext_array.to_list_map + (fun (x : Ext_json_types.t) -> + match x with + | Str { str = ":" } -> error () + | Str { str } -> + Some str + (* More rigirous error checking: It would trigger a ninja + syntax error *) + | _ -> None) + input ) ) + | _ -> error () + + type json_map = Ext_json_types.t Map_string.t -let extract_generators (input : json_map) : build_generator list = - match Map_string.find_opt input Bsb_build_schemas.generators with - | Some (Arr { content ; loc_start}) -> - (* Need check is dev build or not *) - Ext_array.fold_left content [] (fun acc x -> - match x with - | Obj { map } -> - (match Map_string.find_opt map Bsb_build_schemas.name , - Map_string.find_opt map Bsb_build_schemas.edge - with - | Some (Str command), Some edge -> - let output, input = extract_input_output edge in - {Bsb_file_groups.input ; output ; command = command.str } :: acc - | _ -> - errorf x "Invalid generator format") - | _ -> errorf x "Invalid generator format" - ) - | Some x -> errorf x "Invalid generator format" +let extract_generators (input : json_map) : build_generator list = + match Map_string.find_opt input Bsb_build_schemas.generators with + | Some (Arr { content; loc_start }) -> + (* Need check is dev build or not *) + Ext_array.fold_left content [] (fun acc x -> + match x with + | Obj { map } -> ( + match + ( Map_string.find_opt map Bsb_build_schemas.name, + Map_string.find_opt map Bsb_build_schemas.edge ) + with + | Some (Str command), Some edge -> + let output, input = extract_input_output edge in + { Bsb_file_groups.input; output; command = command.str } + :: acc + | _ -> errorf x "Invalid generator format" ) + | _ -> errorf x "Invalid generator format") + | Some x -> errorf x "Invalid generator format" | None -> [] -let extract_predicate (m : json_map) : string -> bool = - let excludes = - match Map_string.find_opt m Bsb_build_schemas.excludes with - | None -> [] - | Some (Arr {content = arr}) -> Bsb_build_util.get_list_string arr - | Some x -> Bsb_exception.config_error x "excludes expect array "in - let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in - match slow_re, excludes with - | Some (Str {str = s}), [] -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 - | Some (Str {str = s}) , _::_ -> - let re = Str.regexp s in - fun name -> Str.string_match re name 0 && not (Ext_list.mem_string excludes name) - | Some config, _ -> Bsb_exception.config_error config (Bsb_build_schemas.slow_re ^ " expect a string literal") - | None , _ -> - fun name -> not (Ext_list.mem_string excludes name) + +let extract_predicate (m : json_map) : string -> bool = + let excludes = + match Map_string.find_opt m Bsb_build_schemas.excludes with + | None -> [] + | Some (Arr { content = arr }) -> Bsb_build_util.get_list_string arr + | Some x -> Bsb_exception.config_error x "excludes expect array " + in + let slow_re = Map_string.find_opt m Bsb_build_schemas.slow_re in + match (slow_re, excludes) with + | Some (Str { str = s }), [] -> + let re = Str.regexp s in + fun name -> Str.string_match re name 0 + | Some (Str { str = s }), _ :: _ -> + let re = Str.regexp s in + fun name -> + Str.string_match re name 0 && not (Ext_list.mem_string excludes name) + | Some config, _ -> + Bsb_exception.config_error config + (Bsb_build_schemas.slow_re ^ " expect a string literal") + | None, _ -> fun name -> not (Ext_list.mem_string excludes name) + (** [parsing_source_dir_map cxt input] - Major work done in this function, - assume [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] - is already checked, so we don't need check it again -*) -let try_unlink s = - try Unix.unlink s - with _ -> - Bsb_log.info "@{Failed to remove %s}@." s -let bs_cmt_post_process_cmd = + Major work done in this function, assume + [not toplevel && not (Bsb_dir_index.is_lib_dir dir_index)] is already + checked, so we don't need check it again *) +let try_unlink s = + try Unix.unlink s with _ -> Bsb_log.info "@{Failed to remove %s}@." s + + +let bs_cmt_post_process_cmd = lazy (try Sys.getenv "BS_CMT_POST_PROCESS_CMD" with _ -> "") -type suffix_kind = - | Cmi of int | Cmt of int | Cmj of int | Cmti of int - | Not_any -let classify_suffix (x : string) : suffix_kind = - let i = - Ext_string.ends_with_index x Literals.suffix_cmi in - if i >=0 then Cmi i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmj in - if i >= 0 then Cmj i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmt in - if i >= 0 then Cmt i - else - let i = - Ext_string.ends_with_index x Literals.suffix_cmti in - if i >= 0 then Cmti i - else Not_any - -(** This is the only place where we do some removal during scanning, - configurabl -*) -let prune_staled_bs_js_files - (context : cxt) - (cur_sources : _ Map_string.t ) - : unit = - let lib_parent = - Filename.concat (Filename.concat context.root Bsb_config.lib_bs) - context.cwd in - if Sys.file_exists lib_parent then - let artifacts = Sys.readdir lib_parent in - Ext_array.iter artifacts (fun x -> - let kind = classify_suffix x in - match kind with - | Not_any -> () - | Cmi i | Cmt i | Cmj i | Cmti i -> - let j = - if context.namespace = None then i - else - Ext_string.rindex_neg x '-' - in - if j >= 0 then - let cmp = Ext_string.capitalize_sub x j in - if not (Map_string.mem cur_sources cmp) then - begin (* prune action *) - let filepath = Filename.concat lib_parent x in - (match kind with - | Cmt _ -> - let lazy cmd = bs_cmt_post_process_cmd in - - if cmd <> "" then - Ext_pervasives.try_it (fun _ -> - Sys.command ( - cmd ^ - " -cmt-rm " ^ filepath) - ) - | Cmj _ -> - (* remove .bs.js *) - if context.bs_suffix then - try_unlink - (Filename.concat context.cwd - (String.sub x 0 j ^ Literals.suffix_bs_js) - ) - | _ -> ()); - try_unlink filepath - end - else () (* assert false *) - ) +type suffix_kind = + | Cmi of int + | Cmt of int + | Cmj of int + | Cmti of int + | Not_any +let classify_suffix (x : string) : suffix_kind = + let i = Ext_string.ends_with_index x Literals.suffix_cmi in + if i >= 0 then Cmi i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmj in + if i >= 0 then Cmj i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmt in + if i >= 0 then Cmt i + else + let i = Ext_string.ends_with_index x Literals.suffix_cmti in + if i >= 0 then Cmti i else Not_any +(** Attempt to delete any [.bs.[cm]?js] files for a given artifact. *) +let unlink_bs_suffixes context artifact = + List.iter + (fun suffix -> try_unlink (Filename.concat context.cwd (artifact ^ suffix))) + context.bs_suffixes -(********************************************************************) +(* This is the only place where we do some removal during scanning, + configurably. *) +let prune_staled_bs_js_files (context : cxt) (cur_sources : _ Map_string.t) : + unit = + let lib_parent = + Filename.concat (Filename.concat context.root Bsb_config.lib_bs) context.cwd + in + if Sys.file_exists lib_parent then + let artifacts = Sys.readdir lib_parent in + Ext_array.iter artifacts (fun x -> + let kind = classify_suffix x in + match kind with + | Not_any -> () + | Cmi i | Cmt i | Cmj i | Cmti i -> + let j = + if context.namespace = None then i + else Ext_string.rindex_neg x '-' + in + if j >= 0 then + let cmp = Ext_string.capitalize_sub x j in + if not (Map_string.mem cur_sources cmp) then ( + (* prune action *) + let filepath = Filename.concat lib_parent x in + ( match kind with + | Cmt _ -> + let (lazy cmd) = bs_cmt_post_process_cmd in + + if cmd <> "" then + Ext_pervasives.try_it (fun _ -> + Sys.command (cmd ^ " -cmt-rm " ^ filepath)) + | Cmj _ -> unlink_bs_suffixes context (String.sub x 0 j) + | _ -> () ); + try_unlink filepath ) + else () + (* assert false *)) + + +(* ****************************************************************** *) (* starts parsing *) -let rec - parsing_source_dir_map - ({ cwd = dir;} as cxt ) - (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t - = +let rec parsing_source_dir_map ({ cwd = dir } as cxt) + (input : Ext_json_types.t Map_string.t) : Bsb_file_groups.t = if Set_string.mem cxt.ignored_dirs dir then Bsb_file_groups.empty - else - let cur_globbed_dirs = ref false in - let has_generators = not (cxt.cut_generators || not cxt.toplevel) in - let scanned_generators = extract_generators input in - let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in - let base_name_array = - lazy (cur_globbed_dirs := true ; Sys.readdir (Filename.concat cxt.root dir)) in - let output_sources = - Ext_list.fold_left (Ext_list.flat_map scanned_generators (fun x -> x.output)) - Map_string.empty (fun acc o -> - Bsb_db_util.add_basename ~dir acc o) in - let sources = - match Map_string.find_opt input Bsb_build_schemas.files with - | None -> - (** We should avoid temporary files *) - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some (Arr basenames ) -> - Ext_array.fold_left basenames.content output_sources (fun acc basename -> - match basename with - | Str {str = basename;loc} -> - Bsb_db_util.add_basename ~dir acc basename ~error_on_invalid_suffix:loc - | _ -> acc - ) - | Some (Obj {map = map; loc} ) -> (* { excludes : [], slow_re : "" }*) - let predicate = extract_predicate map in - Ext_array.fold_left (Lazy.force base_name_array) output_sources (fun acc basename -> - if is_input_or_output scanned_generators basename || not (predicate basename) then acc - else - Bsb_db_util.add_basename ~dir acc basename - ) - | Some x -> Bsb_exception.config_error x "files field expect array or object " - in + else + let cur_globbed_dirs = ref false in + let has_generators = not (cxt.cut_generators || not cxt.toplevel) in + let scanned_generators = extract_generators input in + let sub_dirs_field = Map_string.find_opt input Bsb_build_schemas.subdirs in + let base_name_array = + lazy + ( cur_globbed_dirs := true; + Sys.readdir (Filename.concat cxt.root dir) ) + in + let output_sources = + Ext_list.fold_left + (Ext_list.flat_map scanned_generators (fun x -> x.output)) + Map_string.empty + (fun acc o -> Bsb_db_util.add_basename ~dir acc o) + in + let sources = + match Map_string.find_opt input Bsb_build_schemas.files with + | None -> + (* We should avoid temporary files *) + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if is_input_or_output scanned_generators basename then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some (Arr basenames) -> + Ext_array.fold_left basenames.content output_sources + (fun acc basename -> + match basename with + | Str { str = basename; loc } -> + Bsb_db_util.add_basename ~dir acc basename + ~error_on_invalid_suffix:loc + | _ -> acc) + | Some (Obj { map; loc }) -> + (* { excludes : [], slow_re : "" }*) + let predicate = extract_predicate map in + Ext_array.fold_left (Lazy.force base_name_array) output_sources + (fun acc basename -> + if + is_input_or_output scanned_generators basename + || not (predicate basename) + then acc + else Bsb_db_util.add_basename ~dir acc basename) + | Some x -> + Bsb_exception.config_error x "files field expect array or object " + in let resources = extract_resources input in - let public = extract_pub input sources in - (** Doing recursive stuff *) - let children = - match sub_dirs_field, - cxt.traverse with - | None , true - | Some (True _), _ -> - let root = cxt.root in - let parent = Filename.concat root dir in - Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty (fun origin x -> - if not (Set_string.mem cxt.ignored_dirs x) && - Sys.is_directory (Filename.concat parent x) then - Bsb_file_groups.merge - ( - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path x); - traverse = true - } Map_string.empty) origin - else origin - ) - (* readdir parent avoiding scanning twice *) - | None, false - | Some (False _), _ -> Bsb_file_groups.empty - | Some s, _ -> parse_sources cxt s - in - (** Do some clean up *) - prune_staled_bs_js_files cxt sources ; - Bsb_file_groups.cons - ~file_group:{ dir ; - sources = sources; - resources ; - public ; - dir_index = cxt.dir_index ; - generators = if has_generators then scanned_generators else [] } - ?globbed_dir:( - if !cur_globbed_dirs then Some dir else None) + let public = extract_pub input sources in + (* Doing recursive stuff *) + let children = + match (sub_dirs_field, cxt.traverse) with + | None, true | Some (True _), _ -> + let root = cxt.root in + let parent = Filename.concat root dir in + Ext_array.fold_left (Lazy.force base_name_array) Bsb_file_groups.empty + (fun origin x -> + if + (not (Set_string.mem cxt.ignored_dirs x)) + && Sys.is_directory (Filename.concat parent x) + then + Bsb_file_groups.merge + (parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path x); + traverse = true; + } + Map_string.empty) + origin + else origin) + (* readdir parent avoiding scanning twice *) + | None, false | Some (False _), _ -> Bsb_file_groups.empty + | Some s, _ -> parse_sources cxt s + in + (* Do some clean up *) + prune_staled_bs_js_files cxt sources; + Bsb_file_groups.cons + ~file_group: + { + dir; + sources; + resources; + public; + dir_index = cxt.dir_index; + generators = (if has_generators then scanned_generators else []); + } + ?globbed_dir:(if !cur_globbed_dirs then Some dir else None) children -and parsing_single_source ({toplevel; dir_index ; cwd} as cxt ) (x : Ext_json_types.t ) - : t = - match x with - | Str { str = dir } -> - if not toplevel && not (Bsb_dir_index.is_lib_dir dir_index) then - Bsb_file_groups.empty - else - parsing_source_dir_map - {cxt with - cwd = Ext_path.concat cwd (Ext_path.simple_convert_node_path_to_os_path dir)} - Map_string.empty - | Obj {map} -> - let current_dir_index = - match Map_string.find_opt map Bsb_build_schemas.type_ with - | Some (Str {str="dev"}) -> - Bsb_dir_index.get_dev_index () - | Some _ -> Bsb_exception.config_error x {|type field expect "dev" literal |} - | None -> dir_index in - if not toplevel && not (Bsb_dir_index.is_lib_dir current_dir_index) then - Bsb_file_groups.empty - else - let dir = - match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - Ext_path.simple_convert_node_path_to_os_path str - | Some x -> Bsb_exception.config_error x "dir expected to be a string" - | None -> - Bsb_exception.config_error x - ( - "required field :" ^ Bsb_build_schemas.dir ^ " missing" ) - +and parsing_single_source ({ toplevel; dir_index; cwd } as cxt) + (x : Ext_json_types.t) : t = + match x with + | Str { str = dir } -> + if (not toplevel) && not (Bsb_dir_index.is_lib_dir dir_index) then + Bsb_file_groups.empty + else + parsing_source_dir_map + { + cxt with + cwd = + Ext_path.concat cwd + (Ext_path.simple_convert_node_path_to_os_path dir); + } + Map_string.empty + | Obj { map } -> + let current_dir_index = + match Map_string.find_opt map Bsb_build_schemas.type_ with + | Some (Str { str = "dev" }) -> Bsb_dir_index.get_dev_index () + | Some _ -> + Bsb_exception.config_error x {|type field expect "dev" literal |} + | None -> dir_index in - parsing_source_dir_map - {cxt with dir_index = current_dir_index; - cwd= Ext_path.concat cwd dir} map + if (not toplevel) && not (Bsb_dir_index.is_lib_dir current_dir_index) then + Bsb_file_groups.empty + else + let dir = + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + Ext_path.simple_convert_node_path_to_os_path str + | Some x -> Bsb_exception.config_error x "dir expected to be a string" + | None -> + Bsb_exception.config_error x + ("required field :" ^ Bsb_build_schemas.dir ^ " missing") + in + + parsing_source_dir_map + { + cxt with + dir_index = current_dir_index; + cwd = Ext_path.concat cwd dir; + } + map | _ -> Bsb_file_groups.empty -and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = - Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> - Bsb_file_groups.merge (parsing_single_source cxt x) origin - ) -and parse_sources ( cxt : cxt) (sources : Ext_json_types.t ) = - match sources with - | Arr file_groups -> - parsing_arr_sources cxt file_groups.content - | _ -> parsing_single_source cxt sources +and parsing_arr_sources cxt (file_groups : Ext_json_types.t array) = + Ext_array.fold_left file_groups Bsb_file_groups.empty (fun origin x -> + Bsb_file_groups.merge (parsing_single_source cxt x) origin) -let scan - ~toplevel - ~root - ~cut_generators - ~namespace - ~bs_suffix - ~ignored_dirs - x : t * int = - Bsb_dir_index.reset (); - let output = - parse_sources { - ignored_dirs; - toplevel; - dir_index = Bsb_dir_index.lib_dir_index; - cwd = Filename.current_dir_name; - root ; - cut_generators; - namespace; - bs_suffix; - traverse = false - } x in - output, Bsb_dir_index.get_current_number_of_dev_groups () + +and parse_sources (cxt : cxt) (sources : Ext_json_types.t) = + match sources with + | Arr file_groups -> parsing_arr_sources cxt file_groups.content + | _ -> parsing_single_source cxt sources +let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffixes ~ignored_dirs x + : t * int = + Bsb_dir_index.reset (); + let output = + parse_sources + { + ignored_dirs; + toplevel; + dir_index = Bsb_dir_index.lib_dir_index; + cwd = Filename.current_dir_name; + root; + cut_generators; + namespace; + bs_suffixes; + traverse = false; + } + x + in + (output, Bsb_dir_index.get_current_number_of_dev_groups ()) + -(* Walk through to do some work *) +(* Walk through to do some work *) type walk_cxt = { - cwd : string ; - root : string; - traverse : bool; - ignored_dirs : Set_string.t; - } - -let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = - match sources with - | Arr {content} -> - Ext_array.iter content (fun x -> walk_single_source cxt x) - | x -> walk_single_source cxt x -and walk_single_source cxt (x : Ext_json_types.t) = - match x with - | Str {str = dir} - -> - let dir = Ext_path.simple_convert_node_path_to_os_path dir in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir } None - | Obj {map} -> - begin match Map_string.find_opt map Bsb_build_schemas.dir with - | Some (Str{str}) -> - let dir = Ext_path.simple_convert_node_path_to_os_path str in - walk_source_dir_map - {cxt with cwd = Ext_path.concat cxt.cwd dir} (Map_string.find_opt map Bsb_build_schemas.subdirs) - | _ -> () - end - | _ -> () -and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = - let working_dir = Filename.concat cxt.root cxt.cwd in - if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then begin - let file_array = Sys.readdir working_dir in - (* Remove .re.js when clean up *) - Ext_array.iter file_array begin fun file -> - if Ext_string.ends_with file Literals.suffix_gen_js - || Ext_string.ends_with file Literals.suffix_gen_tsx - then - Sys.remove (Filename.concat working_dir file) - end; - let cxt_traverse = cxt.traverse in - match sub_dirs_field, cxt_traverse with - | None, true - | Some(True _), _ -> - Ext_array.iter file_array begin fun f -> - if not (Set_string.mem cxt.ignored_dirs f) && - Sys.is_directory (Filename.concat working_dir f ) then - walk_source_dir_map - {cxt with - cwd = - Ext_path.concat cxt.cwd - (Ext_path.simple_convert_node_path_to_os_path f); - traverse = true - } None - end - | None, _ - | Some (False _), _ -> () - | Some s, _ -> walk_sources cxt s - end + cwd : string; + root : string; + traverse : bool; + ignored_dirs : Set_string.t; +} + +let rec walk_sources (cxt : walk_cxt) (sources : Ext_json_types.t) = + match sources with + | Arr { content } -> + Ext_array.iter content (fun x -> walk_single_source cxt x) + | x -> walk_single_source cxt x + + +and walk_single_source cxt (x : Ext_json_types.t) = + match x with + | Str { str = dir } -> + let dir = Ext_path.simple_convert_node_path_to_os_path dir in + walk_source_dir_map { cxt with cwd = Ext_path.concat cxt.cwd dir } None + | Obj { map } -> ( + match Map_string.find_opt map Bsb_build_schemas.dir with + | Some (Str { str }) -> + let dir = Ext_path.simple_convert_node_path_to_os_path str in + walk_source_dir_map + { cxt with cwd = Ext_path.concat cxt.cwd dir } + (Map_string.find_opt map Bsb_build_schemas.subdirs) + | _ -> () ) + | _ -> () + + +and walk_source_dir_map (cxt : walk_cxt) sub_dirs_field = + let working_dir = Filename.concat cxt.root cxt.cwd in + if not (Set_string.mem cxt.ignored_dirs cxt.cwd) then ( + let file_array = Sys.readdir working_dir in + (* Remove .re.js when clean up *) + Ext_array.iter file_array (fun file -> + if + Ext_string.ends_with file Literals.suffix_gen_js + || Ext_string.ends_with file Literals.suffix_gen_tsx + then Sys.remove (Filename.concat working_dir file)); + let cxt_traverse = cxt.traverse in + match (sub_dirs_field, cxt_traverse) with + | None, true | Some (True _), _ -> + Ext_array.iter file_array (fun f -> + if + (not (Set_string.mem cxt.ignored_dirs f)) + && Sys.is_directory (Filename.concat working_dir f) + then + walk_source_dir_map + { + cxt with + cwd = + Ext_path.concat cxt.cwd + (Ext_path.simple_convert_node_path_to_os_path f); + traverse = true; + } + None) + | None, _ | Some (False _), _ -> () + | Some s, _ -> walk_sources cxt s ) + + (* It makes use of the side effect when [walk_sources], removing suffix_re_js, - TODO: make it configurable - *) -let clean_re_js root = - match Ext_json_parse.parse_json_from_file - (Filename.concat root Literals.bsconfig_json) with - | Obj { map } -> - let ignored_dirs = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with - | Some (Arr {content = x}) -> Set_string.of_list (Bsb_build_util.get_list_string x ) - | Some _ - | None -> Set_string.empty - in - Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) begin fun config -> - Ext_pervasives.try_it (fun () -> - walk_sources { root ; - traverse = true; - cwd = Filename.current_dir_name; - ignored_dirs - } config - ) - end - | _ -> () - | exception _ -> () - + TODO: make it configurable *) +let clean_re_js root = + match + Ext_json_parse.parse_json_from_file + (Filename.concat root Literals.bsconfig_json) + with + | Obj { map } -> + let ignored_dirs = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + | Some (Arr { content = x }) -> + Set_string.of_list (Bsb_build_util.get_list_string x) + | Some _ | None -> Set_string.empty + in + Ext_option.iter (Map_string.find_opt map Bsb_build_schemas.sources) + (fun config -> + Ext_pervasives.try_it (fun () -> + walk_sources + { + root; + traverse = true; + cwd = Filename.current_dir_name; + ignored_dirs; + } + config)) + | _ -> () + | exception _ -> () + end module Bsb_unix : sig #1 "bsb_unix.mli" @@ -11146,21 +11212,12 @@ module Bsb_config_parse : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val package_specs_from_bsconfig : - unit -> Bsb_package_specs.t - - - - -val interpret_json : - toplevel_package_specs:Bsb_package_specs.t option -> - per_proj_dir:string -> - Bsb_config_types.t - - - - +val package_specs_from_bsconfig : unit -> Bsb_package_specs.t +val interpret_json : + toplevel_package_specs:Bsb_package_specs.t option -> + per_proj_dir:string -> + Bsb_config_types.t end = struct #1 "bsb_config_parse.ml" @@ -11188,463 +11245,438 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - let get_list_string = Bsb_build_util.get_list_string -let (//) = Ext_path.combine +let ( // ) = Ext_path.combine let current_package : Bsb_pkg_types.t = Global Bs_version.package_name -let resolve_package cwd package_name = - let x = Bsb_pkg.resolve_bs_package ~cwd package_name in +let resolve_package cwd package_name = + let x = Bsb_pkg.resolve_bs_package ~cwd package_name in { - Bsb_config_types.package_name ; - package_install_path = x // Bsb_config.lib_ocaml + Bsb_config_types.package_name; + package_install_path = x // Bsb_config.lib_ocaml; } + type json_map = Ext_json_types.t Map_string.t -(* Key is the path *) -let (|?) m (key, cb) = - m |> Ext_json.test key cb +(* Key is the path *) +let ( |? ) m (key, cb) = m |> Ext_json.test key cb +let extract_main_entries (map : json_map) = -let extract_main_entries (map :json_map) = - let extract_entries (field : Ext_json_types.t array) = - Ext_array.to_list_map (function - | Ext_json_types.Obj {map} -> - (* kind defaults to bytecode *) - let kind = ref "js" in - let main = ref None in - let _ = map - |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x)) - |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x)) - in - let path = begin match !main with - (* This is technically optional when compiling to js *) - | None when !kind = Literals.js -> - "Index" - | None -> - failwith "Missing field 'main'. That field is required its value needs to be the main module for the target" - | Some path -> path - end in - if !kind = Literals.native then - Some (Bsb_config_types.NativeTarget path) - else if !kind = Literals.bytecode then - Some (Bsb_config_types.BytecodeTarget path) - else if !kind = Literals.js then - Some (Bsb_config_types.JsTarget path) - else - failwith "Missing field 'kind'. That field is required and its value be 'js', 'native' or 'bytecode'" - | _ -> failwith "Unrecognized object inside array 'entries' field.") - field in + Ext_array.to_list_map + (function + | Ext_json_types.Obj { map } -> + (* kind defaults to bytecode *) + let kind = ref "js" in + let main = ref None in + let _ = + map + |? (Bsb_build_schemas.kind, `Str (fun x -> kind := x)) + |? (Bsb_build_schemas.main, `Str (fun x -> main := Some x)) + in + let path = + match !main with + (* This is technically optional when compiling to js *) + | None when !kind = Literals.js -> "Index" + | None -> + failwith + "Missing field 'main'. That field is required its value \ + needs to be the main module for the target" + | Some path -> path + in + if !kind = Literals.native then + Some (Bsb_config_types.NativeTarget path) + else if !kind = Literals.bytecode then + Some (Bsb_config_types.BytecodeTarget path) + else if !kind = Literals.js then + Some (Bsb_config_types.JsTarget path) + else + failwith + "Missing field 'kind'. That field is required and its value be \ + 'js', 'native' or 'bytecode'" + | _ -> failwith "Unrecognized object inside array 'entries' field.") + field + in let entries = ref Bsb_default.main_entries in - begin match Map_string.find_opt map Bsb_build_schemas.entries with - | Some (Arr {content = s}) -> entries := extract_entries s - | _ -> () - end; !entries - + ( match Map_string.find_opt map Bsb_build_schemas.entries with + | Some (Arr { content = s }) -> entries := extract_entries s + | _ -> () ); + !entries -let package_specs_from_bsconfig () = - let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in - begin match json with - | Obj {map} -> - begin - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> - Bsb_package_specs.default_package_specs - end - | _ -> assert false - end +let deprecated_extract_bs_suffix_exn (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.suffix with + | None -> None + | Some (Str { str } as config) -> + if str = Literals.suffix_js then Some false + else if str = Literals.suffix_bs_js then Some true + else + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports either `.js` or \ + `.bs.js`. Use 'suffix' under 'package-specs' instead." + | Some config -> + Bsb_exception.config_error config + "DEPRECATED: This form of 'suffix' only supports a string" +let package_specs_from_obj_map (map : json_map) = + let deprecated_bs_suffix = deprecated_extract_bs_suffix_exn map in + match Map_string.find_opt map Bsb_build_schemas.package_specs with + | Some x -> Bsb_package_specs.from_json ?deprecated_bs_suffix x + | None -> Bsb_package_specs.default_package_specs ?deprecated_bs_suffix () -(*TODO: it is a little mess that [cwd] and [project dir] are shared*) +let package_specs_from_bsconfig () = + let json = Ext_json_parse.parse_json_from_file Literals.bsconfig_json in + match json with + | Obj { map } -> package_specs_from_obj_map map + | _ -> assert false -let extract_package_name_and_namespace - (map : json_map) : string * string option = - let package_name = - match Map_string.find_opt map Bsb_build_schemas.name with +(*TODO: it is a little mess that [cwd] and [project dir] are shared*) - | Some (Str { str = "_" } as config) - -> - Bsb_exception.config_error config "_ is a reserved package name" - | Some (Str {str = name }) -> - name - | Some config -> - Bsb_exception.config_error config - "name expect a string field" - | None -> - Bsb_exception.invalid_spec - "field name is required" - in - let namespace = - match Map_string.find_opt map Bsb_build_schemas.namespace with - | None - | Some (False _) - -> None - | Some (True _) -> - Some (Ext_namespace.namespace_of_package_name package_name) - | Some (Str {str}) -> - (*TODO : check the validity of namespace *) - Some (Ext_namespace.namespace_of_package_name str) +let extract_package_name_and_namespace (map : json_map) : string * string option + = + let package_name = + match Map_string.find_opt map Bsb_build_schemas.name with + | Some (Str { str = "_" } as config) -> + Bsb_exception.config_error config "_ is a reserved package name" + | Some (Str { str = name }) -> name + | Some config -> + Bsb_exception.config_error config "name expect a string field" + | None -> Bsb_exception.invalid_spec "field name is required" + in + let namespace = + match Map_string.find_opt map Bsb_build_schemas.namespace with + | None | Some (False _) -> None + | Some (True _) -> + Some (Ext_namespace.namespace_of_package_name package_name) + | Some (Str { str }) -> + (*TODO : check the validity of namespace *) + Some (Ext_namespace.namespace_of_package_name str) | Some x -> - Bsb_exception.config_error x - "namespace field expects string or boolean" - in - package_name, namespace + Bsb_exception.config_error x "namespace field expects string or boolean" + in + (package_name, namespace) -(** - There are two things to check: - - the running bsb and vendoring bsb is the same - - the running bsb need delete stale build artifacts - (kinda check npm upgrade) -*) -let check_version_exit (map : json_map) stdlib_path = - match Map_string.find_exn map Bsb_build_schemas.version with - | Str {str } -> - if str <> Bs_version.version then - begin +(* There are two things to check: - the running bsb and vendoring bsb is the + same - the running bsb need delete stale build artifacts (kinda check npm + upgrade) *) +let check_version_exit (map : json_map) stdlib_path = + match Map_string.find_exn map Bsb_build_schemas.version with + | Str { str } -> + if str <> Bs_version.version then ( Format.fprintf Format.err_formatter - "@{bs-platform version mismatch@} Running bsb @{%s@} (%s) vs vendored @{%s@} (%s)@." + "@{bs-platform version mismatch@} Running bsb @{%s@} \ + (%s) vs vendored @{%s@} (%s)@." Bs_version.version (Filename.dirname (Filename.dirname Sys.executable_name)) - str - stdlib_path - ; - exit 2 - end + str stdlib_path; + exit 2 ) | _ -> assert false -let check_stdlib (map : json_map) cwd (*built_in_package*) = - match Map_string.find_opt map Bsb_build_schemas.use_stdlib with - | Some (False _) -> None - | None - | Some _ -> - begin - let stdlib_path = - Bsb_pkg.resolve_bs_package ~cwd current_package in - let json_spec = - Ext_json_parse.parse_json_from_file - (Filename.concat stdlib_path Literals.package_json) in - match json_spec with - | Obj {map} -> - check_version_exit map stdlib_path; - Some { - Bsb_config_types.package_name = current_package; - package_install_path = stdlib_path // Bsb_config.lib_ocaml; - } - - | _ -> assert false - end -let extract_bs_suffix_exn (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.suffix with - | None -> false - | Some (Str {str} as config ) -> - if str = Literals.suffix_js then false - else if str = Literals.suffix_bs_js then true - else Bsb_exception.config_error config - "expect .bs.js or .js string here" - | Some config -> - Bsb_exception.config_error config - "expect .bs.js or .js string here" - -let extract_gentype_config (map : json_map) cwd - : Bsb_config_types.gentype_config option = - match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with +let check_stdlib (map : json_map) cwd (*built_in_package*) = + match Map_string.find_opt map Bsb_build_schemas.use_stdlib with + | Some (False _) -> None + | None | Some _ -> ( + let stdlib_path = Bsb_pkg.resolve_bs_package ~cwd current_package in + let json_spec = + Ext_json_parse.parse_json_from_file + (Filename.concat stdlib_path Literals.package_json) + in + match json_spec with + | Obj { map } -> + check_version_exit map stdlib_path; + Some + { + Bsb_config_types.package_name = current_package; + package_install_path = stdlib_path // Bsb_config.lib_ocaml; + } + | _ -> assert false ) + + +let extract_gentype_config (map : json_map) cwd : + Bsb_config_types.gentype_config option = + match Map_string.find_opt map Bsb_build_schemas.gentypeconfig with | None -> None - | Some (Obj {map = obj}) -> - Some { path = - match Map_string.find_opt obj Bsb_build_schemas.path with - | None -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" - "gentype/gentype.exe").path - | Some (Str {str}) -> - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:"gentype.exe" str).path - | Some config -> - Bsb_exception.config_error config - "path expect to be a string" - } - - | Some config -> - Bsb_exception.config_error - config "gentypeconfig expect an object" - -let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = - match Map_string.find_opt map Bsb_build_schemas.refmt with - | Some (Flo {flo} as config) -> - begin match flo with + | Some (Obj { map = obj }) -> + Some + { + path = + ( match Map_string.find_opt obj Bsb_build_schemas.path with + | None -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + "gentype/gentype.exe") + .path + | Some (Str { str }) -> + (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:"gentype.exe" + str) + .path + | Some config -> + Bsb_exception.config_error config "path expect to be a string" + ); + } + | Some config -> + Bsb_exception.config_error config "gentypeconfig expect an object" + + +let extract_refmt (map : json_map) cwd : Bsb_config_types.refmt = + match Map_string.find_opt map Bsb_build_schemas.refmt with + | Some (Flo { flo } as config) -> ( + match flo with | "3" -> None - | _ -> Bsb_exception.config_error config "expect version 3 only" - end - | Some (Str {str}) - -> - Some - (Bsb_build_util.resolve_bsb_magic_file - ~cwd ~desc:Bsb_build_schemas.refmt str).path - | Some config -> - Bsb_exception.config_error config "expect version 2 or 3" - | None -> - None - -let extract_string (map : json_map) (field : string) cb = - match Map_string.find_opt map field with - | None -> None - | Some (Str{str}) -> cb str - | Some config -> - Bsb_exception.config_error config (field ^ " expect a string" ) - -let extract_boolean (map : json_map) (field : string) (default : bool) : bool = - match Map_string.find_opt map field with - | None -> default - | Some (True _ ) -> true - | Some (False _) -> false - | Some config -> - Bsb_exception.config_error config (field ^ " expect a boolean" ) - -let extract_reason_react_jsx (map : json_map) = - let default : Bsb_config_types.reason_react_jsx option ref = ref None in + | _ -> Bsb_exception.config_error config "expect version 3 only" ) + | Some (Str { str }) -> + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.refmt str) + .path + | Some config -> Bsb_exception.config_error config "expect version 2 or 3" + | None -> None + + +let extract_string (map : json_map) (field : string) cb = + match Map_string.find_opt map field with + | None -> None + | Some (Str { str }) -> cb str + | Some config -> Bsb_exception.config_error config (field ^ " expect a string") + + +let extract_boolean (map : json_map) (field : string) (default : bool) : bool = + match Map_string.find_opt map field with + | None -> default + | Some (True _) -> true + | Some (False _) -> false + | Some config -> + Bsb_exception.config_error config (field ^ " expect a boolean") + + +let extract_reason_react_jsx (map : json_map) = + let default : Bsb_config_types.reason_react_jsx option ref = ref None in map - |? (Bsb_build_schemas.reason, `Obj begin fun m -> - match Map_string.find_opt m Bsb_build_schemas.react_jsx with - | Some (Flo{loc; flo}) -> - begin match flo with - | "2" -> - default := Some Jsx_v2 - | "3" -> - default := Some Jsx_v3 - | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo - end - | Some x -> Bsb_exception.config_error x - "Unexpected input (expect a version number) for jsx, note boolean is no longer allowed" - | None -> () - end) + |? ( Bsb_build_schemas.reason, + `Obj + (fun m -> + match Map_string.find_opt m Bsb_build_schemas.react_jsx with + | Some (Flo { loc; flo }) -> ( + match flo with + | "2" -> default := Some Jsx_v2 + | "3" -> default := Some Jsx_v3 + | _ -> Bsb_exception.errorf ~loc "Unsupported jsx version %s" flo + ) + | Some x -> + Bsb_exception.config_error x + "Unexpected input (expect a version number) for jsx, note \ + boolean is no longer allowed" + | None -> ()) ) |> ignore; !default -let extract_warning (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.warnings with - | None -> Bsb_warning.use_default - | Some (Obj {map }) -> Bsb_warning.from_map map + +let extract_warning (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.warnings with + | None -> Bsb_warning.use_default + | Some (Obj { map }) -> Bsb_warning.from_map map | Some config -> Bsb_exception.config_error config "expect an object" -let extract_ignored_dirs (map : json_map) = - match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with + +let extract_ignored_dirs (map : json_map) = + match Map_string.find_opt map Bsb_build_schemas.ignored_dirs with | None -> Set_string.empty - | Some (Arr {content}) -> - Set_string.of_list (Bsb_build_util.get_list_string content) - | Some config -> - Bsb_exception.config_error config "expect an array of string" - -let extract_generators (map : json_map) = - let generators = ref Map_string.empty in - (match Map_string.find_opt map Bsb_build_schemas.generators with - | None -> () - | Some (Arr {content = s}) -> - generators := - Ext_array.fold_left s Map_string.empty (fun acc json -> - match json with - | Obj {map = m ; loc} -> - begin match Map_string.find_opt m Bsb_build_schemas.name, - Map_string.find_opt m Bsb_build_schemas.command with - | Some (Str {str = name}), Some ( Str {str = command}) -> - Map_string.add acc name command - | _, _ -> - Bsb_exception.errorf ~loc {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} - end - | _ -> acc ) - | Some config -> - Bsb_exception.config_error config (Bsb_build_schemas.generators ^ " expect an array field") - ); + | Some (Arr { content }) -> + Set_string.of_list (Bsb_build_util.get_list_string content) + | Some config -> Bsb_exception.config_error config "expect an array of string" + + +let extract_generators (map : json_map) = + let generators = ref Map_string.empty in + ( match Map_string.find_opt map Bsb_build_schemas.generators with + | None -> () + | Some (Arr { content = s }) -> + generators := + Ext_array.fold_left s Map_string.empty (fun acc json -> + match json with + | Obj { map = m; loc } -> ( + match + ( Map_string.find_opt m Bsb_build_schemas.name, + Map_string.find_opt m Bsb_build_schemas.command ) + with + | Some (Str { str = name }), Some (Str { str = command }) -> + Map_string.add acc name command + | _, _ -> + Bsb_exception.errorf ~loc + {| generators exepect format like { "name" : "cppo", "command" : "cppo $in -o $out"} |} + ) + | _ -> acc) + | Some config -> + Bsb_exception.config_error config + (Bsb_build_schemas.generators ^ " expect an array field") ); !generators - -let extract_dependencies (map : json_map) cwd (field : string ) - : Bsb_config_types.dependencies = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr ({content = s})) -> - Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> resolve_package cwd (Bsb_pkg_types.string_as_package s)) - | Some config -> - Bsb_exception.config_error config - (field ^ " expect an array") - -(* return an empty array if not found *) -let extract_string_list (map : json_map) (field : string) : string list = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr {content = s}) -> - Bsb_build_util.get_list_string s - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") - -let extract_ppx - (map : json_map) - (field : string) - ~(cwd : string) : Bsb_config_types.ppx list = - match Map_string.find_opt map field with - | None -> [] - | Some (Arr {content }) -> - let resolve s = - if s = "" then Bsb_exception.invalid_spec "invalid ppx, empty string found" - else - (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.ppx_flags s).path in - Ext_array.to_list_f content (fun x -> - match x with - | Str x -> - - {Bsb_config_types.name = - resolve x.str; - args = []} - | Arr {content } -> - - let xs = Bsb_build_util.get_list_string content in - (match xs with - | [] -> Bsb_exception.config_error x " empty array is not allowed" - | name :: args -> - {Bsb_config_types.name = resolve name ; args} - ) - | config -> Bsb_exception.config_error config - (field ^ "expect each item to be either string or array") - ) - | Some config -> - Bsb_exception.config_error config (field ^ " expect an array") +let extract_dependencies (map : json_map) cwd (field : string) : + Bsb_config_types.dependencies = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content = s }) -> + Ext_list.map (Bsb_build_util.get_list_string s) (fun s -> + resolve_package cwd (Bsb_pkg_types.string_as_package s)) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") -let extract_js_post_build (map : json_map) cwd : string option = - let js_post_build_cmd = ref None in - map - |? (Bsb_build_schemas.js_post_build, `Obj begin fun m -> - m |? (Bsb_build_schemas.cmd , `Str (fun s -> - js_post_build_cmd := Some (Bsb_build_util.resolve_bsb_magic_file ~cwd ~desc:Bsb_build_schemas.js_post_build s).path +(* return an empty array if not found *) +let extract_string_list (map : json_map) (field : string) : string list = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content = s }) -> Bsb_build_util.get_list_string s + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") - ) - ) - |> ignore - end) - |> ignore ; +let extract_ppx (map : json_map) (field : string) ~(cwd : string) : + Bsb_config_types.ppx list = + match Map_string.find_opt map field with + | None -> [] + | Some (Arr { content }) -> + let resolve s = + if s = "" then + Bsb_exception.invalid_spec "invalid ppx, empty string found" + else + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.ppx_flags s) + .path + in + Ext_array.to_list_f content (fun x -> + match x with + | Str x -> { Bsb_config_types.name = resolve x.str; args = [] } + | Arr { content } -> ( + let xs = Bsb_build_util.get_list_string content in + match xs with + | [] -> Bsb_exception.config_error x " empty array is not allowed" + | name :: args -> { Bsb_config_types.name = resolve name; args } ) + | config -> + Bsb_exception.config_error config + (field ^ "expect each item to be either string or array")) + | Some config -> Bsb_exception.config_error config (field ^ " expect an array") + + +let extract_js_post_build (map : json_map) cwd : string option = + let js_post_build_cmd = ref None in + map + |? ( Bsb_build_schemas.js_post_build, + `Obj + (fun m -> + m + |? ( Bsb_build_schemas.cmd, + `Str + (fun s -> + js_post_build_cmd := + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd + ~desc:Bsb_build_schemas.js_post_build s) + .path) ) + |> ignore) ) + |> ignore; !js_post_build_cmd -(** ATT: make sure such function is re-entrant. - With a given [cwd] it works anywhere*) -let interpret_json - ~toplevel_package_specs - ~per_proj_dir:(per_proj_dir:string) - : Bsb_config_types.t = - - (** we should not resolve it too early, - since it is external configuration, no {!Bsb_build_util.convert_and_resolve_path} - *) - - - - - (* When we plan to add more deps here, - Make sure check it is consistent that for nested deps, we have a - quck check by just re-parsing deps - Make sure it works with [-make-world] [-clean-world] - *) - +(* ATT: make sure such function is re-entrant. With a given [cwd] it works + anywhere *) +let interpret_json ~toplevel_package_specs ~(per_proj_dir : string) : + Bsb_config_types.t = + (* we should not resolve it too early, since it is external configuration, no + {!Bsb_build_util.convert_and_resolve_path} *) + (* When we plan to add more deps here, make sure check it is consistent that + for nested deps, we have a quck check by just re-parsing deps. Make sure it + works with [-make-world] [-clean-world]. *) (* Setting ninja is a bit complex + 1. if [build.ninja] does use [ninja] we need set a variable - 2. we need store it so that we can call ninja correctly - *) - match Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) with - | Obj { map } -> - let package_name, namespace = - extract_package_name_and_namespace map in - let refmt = extract_refmt map per_proj_dir in - let gentype_config = extract_gentype_config map per_proj_dir in - let bs_suffix = extract_bs_suffix_exn map in - (* The default situation is empty *) - let built_in_package = check_stdlib map per_proj_dir in - let package_specs = - match Map_string.find_opt map Bsb_build_schemas.package_specs with - | Some x -> - Bsb_package_specs.from_json x - | None -> Bsb_package_specs.default_package_specs - in - let pp_flags : string option = - extract_string map Bsb_build_schemas.pp_flags (fun p -> - if p = "" then - Bsb_exception.invalid_spec "invalid pp, empty string found" - else - Some (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir ~desc:Bsb_build_schemas.pp_flags p).path - ) in - let reason_react_jsx = extract_reason_react_jsx map in - let bs_dependencies = extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies in - let toplevel = toplevel_package_specs = None in - let bs_dev_dependencies = - if toplevel then - extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dev_dependencies - else [] in - begin match Map_string.find_opt map Bsb_build_schemas.sources with - | Some sources -> - let cut_generators = - extract_boolean map Bsb_build_schemas.cut_generators false in - let groups, number_of_dev_groups = Bsb_parse_sources.scan - ~ignored_dirs:(extract_ignored_dirs map) - ~toplevel - ~root: per_proj_dir - ~cut_generators - ~bs_suffix - ~namespace - sources in - { - gentype_config; - bs_suffix ; - package_name ; - namespace ; - warning = extract_warning map; - external_includes = extract_string_list map Bsb_build_schemas.bs_external_includes; - bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags ; - ppx_files = extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; - pp_file = pp_flags ; - bs_dependencies ; - bs_dev_dependencies ; - (* - reference for quoting - {[ - let tmpfile = Filename.temp_file "ocamlpp" "" in - let comm = Printf.sprintf "%s %s > %s" - pp (Filename.quote sourcefile) tmpfile - in - ]} - *) - refmt; - js_post_build_cmd = (extract_js_post_build map per_proj_dir); - package_specs = - (match toplevel_package_specs with - | None -> package_specs - | Some x -> x ); - file_groups = groups; - files_to_install = Hash_set_string.create 96; - built_in_dependency = built_in_package; - generate_merlin = - extract_boolean map Bsb_build_schemas.generate_merlin true; - reason_react_jsx ; - entries = extract_main_entries map; - generators = extract_generators map ; - cut_generators ; - number_of_dev_groups; - } - | None -> - Bsb_exception.invalid_spec - "no sources specified in bsconfig.json" - end - | _ -> - Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" + + 2. we need store it so that we can call ninja correctly *) + match + Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json) + with + | Obj { map } -> ( + let package_name, namespace = extract_package_name_and_namespace map in + let refmt = extract_refmt map per_proj_dir in + let gentype_config = extract_gentype_config map per_proj_dir in + (* The default situation is empty *) + let built_in_package = check_stdlib map per_proj_dir in + let package_specs = package_specs_from_obj_map map in + let bs_suffixes = + Bsb_package_specs.extract_in_source_bs_suffixes package_specs + in + let pp_flags : string option = + extract_string map Bsb_build_schemas.pp_flags (fun p -> + if p = "" then + Bsb_exception.invalid_spec "invalid pp, empty string found" + else + Some + (Bsb_build_util.resolve_bsb_magic_file ~cwd:per_proj_dir + ~desc:Bsb_build_schemas.pp_flags p) + .path) + in + let reason_react_jsx = extract_reason_react_jsx map in + let bs_dependencies = + extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies + in + let toplevel = toplevel_package_specs = None in + let bs_dev_dependencies = + if toplevel then + extract_dependencies map per_proj_dir + Bsb_build_schemas.bs_dev_dependencies + else [] + in + match Map_string.find_opt map Bsb_build_schemas.sources with + | Some sources -> + let cut_generators = + extract_boolean map Bsb_build_schemas.cut_generators false + in + let groups, number_of_dev_groups = + Bsb_parse_sources.scan ~ignored_dirs:(extract_ignored_dirs map) + ~toplevel ~root:per_proj_dir ~cut_generators ~bs_suffixes + ~namespace sources + in + { + gentype_config; + package_name; + namespace; + warning = extract_warning map; + external_includes = + extract_string_list map Bsb_build_schemas.bs_external_includes; + bsc_flags = extract_string_list map Bsb_build_schemas.bsc_flags; + ppx_files = + extract_ppx map ~cwd:per_proj_dir Bsb_build_schemas.ppx_flags; + pp_file = pp_flags; + bs_dependencies; + bs_dev_dependencies; + (* reference for quoting {[ let tmpfile = Filename.temp_file + "ocamlpp" "" in let comm = Printf.sprintf "%s %s > %s" pp + (Filename.quote sourcefile) tmpfile in ]} *) + refmt; + js_post_build_cmd = extract_js_post_build map per_proj_dir; + package_specs = + ( match toplevel_package_specs with + | None -> package_specs + | Some x -> x ); + file_groups = groups; + files_to_install = Hash_set_string.create 96; + built_in_dependency = built_in_package; + generate_merlin = + extract_boolean map Bsb_build_schemas.generate_merlin true; + reason_react_jsx; + entries = extract_main_entries map; + generators = extract_generators map; + cut_generators; + number_of_dev_groups; + } + | None -> + Bsb_exception.invalid_spec "no sources specified in bsconfig.json" ) + | _ -> Bsb_exception.invalid_spec "bsconfig.json expect a json object {}" end module Ext_io : sig @@ -12563,65 +12595,55 @@ module Bsb_ninja_rule : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - +type t (** The complexity comes from the fact that we allow custom rules which could - conflict with our custom built-in rules -*) -type t + conflict with our custom built-in rules *) - -val get_name : t -> out_channel -> string +val get_name : t -> out_channel -> string (***********************************************************) -(** A list of existing rules *) + type builtin = { - build_ast : t; - build_ast_from_re : t ; - - (** platform dependent, on Win32, - invoking cmd.exe - *) - copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_ast_from_re : t; + copy_resources : t; (** platform dependent, on Win32, invoking cmd.exe *) + build_bin_deps : t; (** Rules below all need restat *) ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } -(***********************************************************) +(** A list of existing rules *) -(** rules are generally composed of built-in rules and customized rules, there are two design choices: - 1. respect custom rules with the same name, then we need adjust our built-in - rules dynamically in case the conflict. - 2. respect our built-in rules, then we only need re-load custom rules for each bsconfig.json -*) +(***********************************************************) type command = string -(** Since now we generate ninja files per bsconfig.json in a single process, - we must make sure it is re-entrant -*) -val make_custom_rules : + +val make_custom_rules : has_gentype:bool -> has_postbuild:bool -> has_ppx:bool -> has_pp:bool -> - has_builtin:bool -> - bs_suffix:bool -> - reason_react_jsx : Bsb_config_types.reason_react_jsx option -> + has_builtin:bool -> + reason_react_jsx:Bsb_config_types.reason_react_jsx option -> digest:string -> refmt:string option -> command Map_string.t -> builtin +(** rules are generally composed of built-in rules and customized rules, there + are two design choices: + + + respect custom rules with the same name, then we need adjust our built-in + rules dynamically in case the conflict. + + respect our built-in rules, then we only need re-load custom rules for + each bsconfig.json + NOTE: Since now we generate ninja files per bsconfig.json in a single + process, we must make sure it is re-entrant *) end = struct #1 "bsb_ninja_rule.ml" @@ -12649,241 +12671,178 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -type t = { - mutable used : bool; - rule_name : string; - name : out_channel -> string +type t = { + mutable used : bool; + rule_name : string; + name : out_channel -> string; } let get_name (x : t) oc = x.name oc -let print_rule (oc : out_channel) - ~description - ?(restat : unit option) - ?dyndep - ~command - name = - output_string oc "rule "; output_string oc name ; output_string oc "\n"; - output_string oc " command = "; output_string oc command; output_string oc "\n"; +let print_rule (oc : out_channel) ~description ?(restat : unit option) ?dyndep + ~command name = + output_string oc "rule "; + output_string oc name; + output_string oc "\n"; + output_string oc " command = "; + output_string oc command; + output_string oc "\n"; Ext_option.iter dyndep (fun f -> - output_string oc " dyndep = "; output_string oc f; output_string oc "\n" - ); - (if restat <> None then - output_string oc " restat = 1\n"); - - output_string oc " description = " ; output_string oc description; output_string oc "\n" - + output_string oc " dyndep = "; + output_string oc f; + output_string oc "\n"); + if restat <> None then output_string oc " restat = 1\n"; + output_string oc " description = "; + output_string oc description; + output_string oc "\n" (** allocate an unique name for such rule*) -let define - ~command - ?dyndep - ?restat - ?(description = "\027[34mBuilding\027[39m \027[2m${out}\027[22m") (* blue, dim *) - rule_name : t - = - - let rec self = { - used = false; - rule_name ; - name = fun oc -> - if not self.used then - begin - print_rule oc ~description ?dyndep ?restat ~command rule_name; - self.used <- true - end ; - rule_name - } in +let define ~command ?dyndep ?restat + ?(description = + "\027[34mBuilding\027[39m \027[2m${out}\027[22m" (* blue, dim *)) + rule_name : t = + let rec self = + { + used = false; + rule_name; + name = + (fun oc -> + if not self.used then ( + print_rule oc ~description ?dyndep ?restat ~command rule_name; + self.used <- true ); + rule_name); + } + in self - - type command = string type builtin = { build_ast : t; - (** TODO: Implement it on top of pp_flags *) - build_ast_from_re : t ; + (* TODO: Implement it on top of pp_flags *) + build_ast_from_re : t; (* build_ast_from_rei : t ; *) - - - (** platform dependent, on Win32, - invoking cmd.exe - *) copy_resources : t; - (** Rules below all need restat *) - build_bin_deps : t ; - + build_bin_deps : t; ml_cmj_js : t; ml_cmj_js_dev : t; - ml_cmj_cmi_js : t ; - ml_cmj_cmi_js_dev : t ; + ml_cmj_cmi_js : t; + ml_cmj_cmi_js_dev : t; ml_cmi : t; - ml_cmi_dev : t ; - - build_package : t ; - customs : t Map_string.t + ml_cmi_dev : t; + build_package : t; + customs : t Map_string.t; } - -;; - -let make_custom_rules - ~(has_gentype : bool) - ~(has_postbuild : bool) - ~(has_ppx : bool) - ~(has_pp : bool) - ~(has_builtin : bool) - ~(bs_suffix : bool) - ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) - ~(digest : string) - ~(refmt : string option) (* set refmt path when needed *) - (custom_rules : command Map_string.t) : - builtin = - (** FIXME: We don't need set [-o ${out}] when building ast - since the default is already good -- it does not*) - let buf = Buffer.create 100 in - let mk_ml_cmj_cmd - ~read_cmi - ~is_dev - ~postbuild : string = +let make_custom_rules ~(has_gentype : bool) ~(has_postbuild : bool) + ~(has_ppx : bool) ~(has_pp : bool) ~(has_builtin : bool) + ~(reason_react_jsx : Bsb_config_types.reason_react_jsx option) + ~(digest : string) ~(refmt : string option) + (* set refmt path when needed *) + (custom_rules : command Map_string.t) : builtin = + (* FIXME: We don't need set [-o ${out}] when building ast since the default is + already good -- it does not *) + let buf = Buffer.create 100 in + let mk_ml_cmj_cmd ~read_cmi ~is_dev ~postbuild : string = Buffer.clear buf; Buffer.add_string buf "$bsc -nostdlib $g_pkg_flg -color always"; - if bs_suffix then - Buffer.add_string buf " -bs-suffix"; - if read_cmi then - Buffer.add_string buf " -bs-read-cmi"; - if is_dev then - Buffer.add_string buf " $g_dev_incls"; - Buffer.add_string buf " $g_lib_incls" ; - if is_dev then - Buffer.add_string buf " $g_dpkg_incls"; - if has_builtin then - Buffer.add_string buf " -I $g_std_incl"; + if read_cmi then Buffer.add_string buf " -bs-read-cmi"; + if is_dev then Buffer.add_string buf " $g_dev_incls"; + Buffer.add_string buf " $g_lib_incls"; + if is_dev then Buffer.add_string buf " $g_dpkg_incls"; + if has_builtin then Buffer.add_string buf " -I $g_std_incl"; Buffer.add_string buf " $warnings $bsc_flags"; - if has_gentype then - Buffer.add_string buf " $gentypeconfig"; + if has_gentype then Buffer.add_string buf " $gentypeconfig"; Buffer.add_string buf " -o $out $in"; - if postbuild then - Buffer.add_string buf " $postbuild"; + if postbuild then Buffer.add_string buf " $postbuild"; Buffer.contents buf - in + in let mk_ast ~(has_pp : bool) ~has_ppx ~has_reason_react_jsx : string = - Buffer.clear buf ; + Buffer.clear buf; Buffer.add_string buf "$bsc $warnings -color always"; - (match refmt with + ( match refmt with | None -> () | Some x -> - Buffer.add_string buf " -bs-refmt "; - Buffer.add_string buf (Ext_filename.maybe_quote x); - ); - if has_pp then - Buffer.add_string buf " $pp_flags"; - (match has_reason_react_jsx, reason_react_jsx with - | false, _ - | _, None -> () - | _, Some Jsx_v2 - -> Buffer.add_string buf " -bs-jsx 2" - | _, Some Jsx_v3 - -> Buffer.add_string buf " -bs-jsx 3" - ); - if has_ppx then - Buffer.add_string buf " $ppx_flags"; - Buffer.add_string buf " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; + Buffer.add_string buf " -bs-refmt "; + Buffer.add_string buf (Ext_filename.maybe_quote x) ); + if has_pp then Buffer.add_string buf " $pp_flags"; + ( match (has_reason_react_jsx, reason_react_jsx) with + | false, _ | _, None -> () + | _, Some Jsx_v2 -> Buffer.add_string buf " -bs-jsx 2" + | _, Some Jsx_v3 -> Buffer.add_string buf " -bs-jsx 3" ); + if has_ppx then Buffer.add_string buf " $ppx_flags"; + Buffer.add_string buf + " $bsc_flags -o $out -bs-syntax-only -bs-binary-ast $in"; Buffer.contents buf - in + in let build_ast = define - ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false ) - "build_ast" in + ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:false) + "build_ast" + in let build_ast_from_re = define ~command:(mk_ast ~has_pp ~has_ppx ~has_reason_react_jsx:true) - "build_ast_from_re" in - - let copy_resources = - define - ~command:( - if Ext_sys.is_windows_or_cygwin then - "cmd.exe /C copy /Y $in $out > null" - else "cp $in $out" - ) - "copy_resource" in - let build_bin_deps = + "build_ast_from_re" + in + + let copy_resources = define - ~restat:() ~command: - ("$bsdep -hash " ^ digest ^" $g_ns -g $bsb_dir_group $in") - "build_deps" in - let aux ~name ~read_cmi ~postbuild = - let postbuild = has_postbuild && postbuild in - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:false - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - name, - define - ~command:(mk_ml_cmj_cmd - ~read_cmi ~is_dev:true - ~postbuild) - ~dyndep:"$in_e.d" - ~restat:() (* Always restat when having mli *) - (name ^ "_dev") - in + ( if Ext_sys.is_windows_or_cygwin then + "cmd.exe /C copy /Y $in $out > null" + else "cp $in $out" ) + "copy_resource" + in + let build_bin_deps = + define ~restat:() + ~command:("$bsdep -hash " ^ digest ^ " $g_ns -g $bsb_dir_group $in") + "build_deps" + in + let aux ~name ~read_cmi ~postbuild = + let postbuild = has_postbuild && postbuild in + ( define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:false ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) name, + define + ~command:(mk_ml_cmj_cmd ~read_cmi ~is_dev:true ~postbuild) + ~dyndep:"$in_e.d" ~restat:() (* Always restat when having mli *) + (name ^ "_dev") ) + in (* [g_lib_incls] are fixed for libs *) let ml_cmj_js, ml_cmj_js_dev = - aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true in + aux ~name:"ml_cmj_only" ~read_cmi:true ~postbuild:true + in let ml_cmj_cmi_js, ml_cmj_cmi_js_dev = - aux - ~read_cmi:false - ~name:"ml_cmj_cmi" ~postbuild:true in + aux ~read_cmi:false ~name:"ml_cmj_cmi" ~postbuild:true + in let ml_cmi, ml_cmi_dev = - aux - ~read_cmi:false ~postbuild:false - ~name:"ml_cmi" in - let build_package = - define - ~command:"$bsc -w -49 -color always -no-alias-deps $in" - ~restat:() + aux ~read_cmi:false ~postbuild:false ~name:"ml_cmi" + in + let build_package = + define ~command:"$bsc -w -49 -color always -no-alias-deps $in" ~restat:() "build_package" - in + in { - build_ast ; - build_ast_from_re ; - (** platform dependent, on Win32, - invoking cmd.exe - *) + build_ast; + build_ast_from_re; copy_resources; - (** Rules below all need restat *) - build_bin_deps ; - - ml_cmj_js ; - ml_cmj_js_dev ; - ml_cmj_cmi_js ; - ml_cmi ; - + build_bin_deps; + ml_cmj_js; + ml_cmj_js_dev; + ml_cmj_cmi_js; + ml_cmi; ml_cmj_cmi_js_dev; ml_cmi_dev; - - build_package ; + build_package; customs = - Map_string.mapi custom_rules begin fun name command -> - define ~command ("custom_" ^ name) - end + Map_string.mapi custom_rules (fun name command -> + define ~command ("custom_" ^ name)); } - - end module Bsb_ninja_targets : sig #1 "bsb_ninja_targets.mli" @@ -13134,18 +13093,15 @@ module Bsb_ninja_file_groups : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - val handle_files_per_dir : out_channel -> - bs_suffix:bool -> rules:Bsb_ninja_rule.builtin -> package_specs:Bsb_package_specs.t -> js_post_build_cmd:string option -> files_to_install:Hash_set_string.t -> - namespace:string option -> - Bsb_file_groups.file_group -> unit + namespace:string option -> + Bsb_file_groups.file_group -> + unit end = struct #1 "bsb_ninja_file_groups.ml" @@ -13173,199 +13129,156 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - - - - - +let ( // ) = Ext_path.combine -let handle_generators oc - (group : Bsb_file_groups.file_group) - custom_rules = - let map_to_source_dir = - (fun x -> Bsb_config.proj_rel (group.dir //x )) in - Ext_list.iter group.generators (fun {output; input; command} -> +let handle_generators oc (group : Bsb_file_groups.file_group) custom_rules = + let map_to_source_dir x = Bsb_config.proj_rel (group.dir // x) in + Ext_list.iter group.generators (fun { output; input; command } -> (*TODO: add a loc for better error message *) - match Map_string.find_opt custom_rules command with - | None -> Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" command - | Some rule -> - Bsb_ninja_targets.output_build oc - ~outputs:(Ext_list.map output map_to_source_dir) - ~inputs:(Ext_list.map input map_to_source_dir) - ~rule - ) - - -let make_common_shadows - package_specs - dirname - dir_index - : Bsb_ninja_targets.shadow list - = - - { key = Bsb_ninja_global_vars.g_pkg_flg; - op = - Append - (Bsb_package_specs.package_flag_of_package_specs - package_specs dirname - ) - } :: - (if Bsb_dir_index.is_lib_dir dir_index then [] else - [ - { key = Bsb_ninja_global_vars.g_dev_incls; - op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); - } - ] - ) - - - -let emit_module_build - (rules : Bsb_ninja_rule.builtin) - (package_specs : Bsb_package_specs.t) - (group_dir_index : Bsb_dir_index.t) - oc - ~bs_suffix - js_post_build_cmd - namespace - (module_info : Bsb_db.module_info) - = - let has_intf_file = module_info.info = Ml_mli in - let is_re = module_info.is_re in - let filename_sans_extension = module_info.name_sans_extension in + match Map_string.find_opt custom_rules command with + | None -> + Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but not defined" + command + | Some rule -> + Bsb_ninja_targets.output_build oc + ~outputs:(Ext_list.map output map_to_source_dir) + ~inputs:(Ext_list.map input map_to_source_dir) + ~rule) + + +let make_common_shadows package_specs dirname dir_index : + Bsb_ninja_targets.shadow list = + { + key = Bsb_ninja_global_vars.g_pkg_flg; + op = + Append + (Bsb_package_specs.flags_of_package_specs package_specs dirname); + } + :: + ( if Bsb_dir_index.is_lib_dir dir_index then [] + else + [ + { + key = Bsb_ninja_global_vars.g_dev_incls; + op = OverwriteVar (Bsb_dir_index.string_of_bsb_dev_include dir_index); + }; + ] ) + + +let emit_module_build (rules : Bsb_ninja_rule.builtin) + (package_specs : Bsb_package_specs.t) (group_dir_index : Bsb_dir_index.t) oc + js_post_build_cmd namespace (module_info : Bsb_db.module_info) = + let has_intf_file = module_info.info = Ml_mli in + let is_re = module_info.is_re in + let filename_sans_extension = module_info.name_sans_extension in let is_dev = not (Bsb_dir_index.is_lib_dir group_dir_index) in - let input_impl = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) in - let input_intf = - Bsb_config.proj_rel - (filename_sans_extension ^ if is_re then Literals.suffix_rei else Literals.suffix_mli) in - let output_mlast = - filename_sans_extension ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast in - let output_mliast = - filename_sans_extension ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast in + let input_impl = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_re else Literals.suffix_ml ) + in + let input_intf = + Bsb_config.proj_rel + ( filename_sans_extension + ^ if is_re then Literals.suffix_rei else Literals.suffix_mli ) + in + let output_mlast = + filename_sans_extension + ^ if is_re then Literals.suffix_reast else Literals.suffix_mlast + in + let output_mliast = + filename_sans_extension + ^ if is_re then Literals.suffix_reiast else Literals.suffix_mliast + in let output_d = filename_sans_extension ^ Literals.suffix_d in - let output_filename_sans_extension = - Ext_namespace.make ?ns:namespace filename_sans_extension - in - let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in - let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in + let output_filename_sans_extension = + Ext_namespace.make ?ns:namespace filename_sans_extension + in + let output_cmi = output_filename_sans_extension ^ Literals.suffix_cmi in + let output_cmj = output_filename_sans_extension ^ Literals.suffix_cmj in let output_js = - Bsb_package_specs.get_list_of_output_js package_specs bs_suffix output_filename_sans_extension in - let common_shadows = + Bsb_package_specs.get_list_of_output_js package_specs + output_filename_sans_extension + in + let common_shadows = make_common_shadows package_specs (Filename.dirname output_cmi) - group_dir_index in - let ast_rule = - if is_re then - rules.build_ast_from_re - else - rules.build_ast in - Bsb_ninja_targets.output_build oc - ~outputs:[output_mlast] - ~inputs:[input_impl] - ~rule:ast_rule; - Bsb_ninja_targets.output_build - oc - ~outputs:[output_d] - ~inputs:(if has_intf_file then [output_mlast;output_mliast] else [output_mlast] ) + group_dir_index + in + let ast_rule = if is_re then rules.build_ast_from_re else rules.build_ast in + Bsb_ninja_targets.output_build oc ~outputs:[ output_mlast ] + ~inputs:[ input_impl ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_d ] + ~inputs: + ( if has_intf_file then [ output_mlast; output_mliast ] + else [ output_mlast ] ) ~rule:rules.build_bin_deps - ?shadows:(if is_dev then - Some [{Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group ; - op = - Overwrite (string_of_int (group_dir_index :> int)) }] - else None) - ; - if has_intf_file then begin - Bsb_ninja_targets.output_build oc - ~outputs:[output_mliast] - (* TODO: we can get rid of absloute path if we fixed the location to be - [lib/bs], better for testing? - *) - ~inputs:[input_intf] - ~rule:ast_rule - ; + ?shadows: + ( if is_dev then + Some + [ + { + Bsb_ninja_targets.key = Bsb_build_schemas.bsb_dir_group; + op = Overwrite (string_of_int (group_dir_index :> int)); + }; + ] + else None ); + if has_intf_file then ( Bsb_ninja_targets.output_build oc - ~outputs:[output_cmi] - ~shadows:common_shadows - ~order_only_deps:[output_d] - ~inputs:[output_mliast] - ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) - ; - end; + ~outputs: + [ output_mliast ] + (* TODO: we can get rid of absloute path if we fixed the location to be + [lib/bs], better for testing? *) + ~inputs:[ input_intf ] ~rule:ast_rule; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmi ] + ~shadows:common_shadows ~order_only_deps:[ output_d ] + ~inputs:[ output_mliast ] + ~rule:(if is_dev then rules.ml_cmi_dev else rules.ml_cmi) ); let shadows = match js_post_build_cmd with | None -> common_shadows | Some cmd -> - {key = Bsb_ninja_global_vars.postbuild; - op = Overwrite ("&& " ^ cmd ^ Ext_string.single_space ^ String.concat Ext_string.single_space output_js)} - :: common_shadows + { + key = Bsb_ninja_global_vars.postbuild; + op = + Overwrite + ( "&& " ^ cmd ^ Ext_string.single_space + ^ String.concat Ext_string.single_space output_js ); + } + :: common_shadows in let rule = - if has_intf_file then - (if is_dev then rules.ml_cmj_js_dev - else rules.ml_cmj_js) - else - (if is_dev then rules.ml_cmj_cmi_js_dev - else rules.ml_cmj_cmi_js - ) + if has_intf_file then + if is_dev then rules.ml_cmj_js_dev else rules.ml_cmj_js + else if is_dev then rules.ml_cmj_cmi_js_dev + else rules.ml_cmj_cmi_js in - Bsb_ninja_targets.output_build oc - ~outputs:[output_cmj] - ~shadows - ~implicit_outputs: - (if has_intf_file then output_js else output_cmi::output_js ) - ~inputs:[output_mlast] - ~implicit_deps:(if has_intf_file then [output_cmi] else [] ) - ~order_only_deps:[output_d] - ~rule - (* ; - {output_cmj; output_cmi} *) - - - - - - -let handle_files_per_dir - oc - ~bs_suffix - ~(rules : Bsb_ninja_rule.builtin) - ~package_specs - ~js_post_build_cmd - ~(files_to_install : Hash_set_string.t) - ~(namespace : string option) - (group: Bsb_file_groups.file_group ) - : unit = - - handle_generators oc group rules.customs ; + Bsb_ninja_targets.output_build oc ~outputs:[ output_cmj ] ~shadows + ~implicit_outputs: + (if has_intf_file then output_js else output_cmi :: output_js) + ~inputs:[ output_mlast ] + ~implicit_deps:(if has_intf_file then [ output_cmi ] else []) + ~order_only_deps:[ output_d ] ~rule + + +let handle_files_per_dir oc ~(rules : Bsb_ninja_rule.builtin) ~package_specs + ~js_post_build_cmd ~(files_to_install : Hash_set_string.t) + ~(namespace : string option) (group : Bsb_file_groups.file_group) : unit = + handle_generators oc group rules.customs; let installable = match group.public with | Export_all -> fun _ -> true | Export_none -> fun _ -> false - | Export_set set -> - fun module_name -> - Set_string.mem set module_name in - Map_string.iter group.sources (fun module_name module_info -> - if installable module_name then - Hash_set_string.add files_to_install - module_info.name_sans_extension; - emit_module_build rules - package_specs - group.dir_index - oc - ~bs_suffix - js_post_build_cmd - namespace module_info - ) - - (* ; - Bsb_ninja_targets.phony - oc ~order_only_deps:[] ~inputs:[] ~output:group.dir *) + | Export_set set -> fun module_name -> Set_string.mem set module_name + in + Map_string.iter group.sources (fun module_name module_info -> + if installable module_name then + Hash_set_string.add files_to_install module_info.name_sans_extension; + emit_module_build rules package_specs group.dir_index oc js_post_build_cmd + namespace module_info) - (* pseuduo targets per directory *) +(* pseuduo targets per directory *) end module Bsb_ninja_gen : sig @@ -13394,13 +13307,9 @@ module Bsb_ninja_gen : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** - generate ninja file based on [cwd] -*) val output_ninja_and_namespace_map : - per_proj_dir:string -> - toplevel:bool -> - Bsb_config_types.t -> unit + per_proj_dir:string -> toplevel:bool -> Bsb_config_types.t -> unit +(** generate ninja file based on [cwd] *) end = struct #1 "bsb_ninja_gen.ml" @@ -13428,235 +13337,196 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let (//) = Ext_path.combine - -(* we need copy package.json into [_build] since it does affect build output - it is a bad idea to copy package.json which requires to copy js files -*) - - +let ( // ) = Ext_path.combine +(* we need copy package.json into [_build] since it does affect build output it + is a bad idea to copy package.json which requires to copy js files *) let dash_i = "-I" +let get_bsc_flags ~(toplevel : bool) (bsc_flags : string list) : string = + String.concat Ext_string.single_space + (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags) + + +let emit_bsc_lib_includes (bs_dependencies : Bsb_config_types.dependencies) + (source_dirs : string list) external_includes (namespace : _ option) + (oc : out_channel) : unit = + (* TODO: bsc_flags contain stdlib path which is in the latter position + currently *) + let all_includes source_dirs = + source_dirs + @ Ext_list.map bs_dependencies (fun x -> x.package_install_path) + @ (* for external includes, if it is absolute path, leave it as is for + relative path './xx', we need '../.././x' since we are in [lib/bs], + [build] is different from merlin though *) + Ext_list.map external_includes (fun x -> + if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) + in + Bsb_ninja_targets.output_kv Bsb_build_schemas.g_lib_incls + (Bsb_build_util.include_dirs + (all_includes + ( if namespace = None then source_dirs + else Filename.current_dir_name :: source_dirs + (*working dir is [lib/bs] we include this path to have namespace + mapping*) ))) + oc -let get_bsc_flags - ~(toplevel : bool) - (bsc_flags : string list) - : string = - String.concat Ext_string.single_space - (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags ) - - -let emit_bsc_lib_includes - (bs_dependencies : Bsb_config_types.dependencies) - (source_dirs : string list) - (external_includes) - (namespace : _ option) - (oc : out_channel): unit = - (* TODO: bsc_flags contain stdlib path which is in the latter position currently *) - let all_includes source_dirs = - source_dirs @ - Ext_list.map bs_dependencies (fun x -> x.package_install_path) @ - ( - (* for external includes, if it is absolute path, leave it as is - for relative path './xx', we need '../.././x' since we are in - [lib/bs], [build] is different from merlin though - *) - Ext_list.map - external_includes - - (fun x -> if Filename.is_relative x then Bsb_config.rev_lib_bs_prefix x else x) - ) - in - Bsb_ninja_targets.output_kv - Bsb_build_schemas.g_lib_incls - (Bsb_build_util.include_dirs - (all_includes - (if namespace = None then source_dirs - else Filename.current_dir_name :: source_dirs - (*working dir is [lib/bs] we include this path to have namespace mapping*) - ))) oc - - -let output_static_resources - (static_resources : string list) - copy_rule - oc - = - Ext_list.iter static_resources (fun output -> - Bsb_ninja_targets.output_build - oc - ~outputs:[output] - ~inputs:[Bsb_config.proj_rel output] +let output_static_resources (static_resources : string list) copy_rule oc = + Ext_list.iter static_resources (fun output -> + Bsb_ninja_targets.output_build oc ~outputs:[ output ] + ~inputs:[ Bsb_config.proj_rel output ] ~rule:copy_rule); if static_resources <> [] then - Bsb_ninja_targets.phony - oc - ~order_only_deps:static_resources - ~inputs:[] - ~output:Literals.build_ninja + Bsb_ninja_targets.phony oc ~order_only_deps:static_resources ~inputs:[] + ~output:Literals.build_ninja -let output_ninja_and_namespace_map - ~per_proj_dir - ~toplevel +let output_ninja_and_namespace_map ~per_proj_dir ~toplevel ({ - bs_suffix; - package_name; - external_includes; - bsc_flags ; - pp_file; - ppx_files ; - - bs_dependencies; - bs_dev_dependencies; - refmt; - js_post_build_cmd; - package_specs; - file_groups = { files = bs_file_groups}; - files_to_install; - built_in_dependency; - reason_react_jsx; - generators ; - namespace ; - warning; - gentype_config; - number_of_dev_groups; - } : Bsb_config_types.t) : unit - = - - let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in + package_name; + external_includes; + bsc_flags; + pp_file; + ppx_files; + bs_dependencies; + bs_dev_dependencies; + refmt; + js_post_build_cmd; + package_specs; + file_groups = { files = bs_file_groups }; + files_to_install; + built_in_dependency; + reason_react_jsx; + generators; + namespace; + warning; + gentype_config; + number_of_dev_groups; + } : + Bsb_config_types.t) : unit = + let cwd_lib_bs = per_proj_dir // Bsb_config.lib_bs in let ppx_flags = Bsb_build_util.ppx_flags ppx_files in - let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in - let g_pkg_flg , g_ns_flg = + let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in + let g_pkg_flg, g_ns_flg = match namespace with - | None -> - Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty - | Some s -> - Ext_string.inter4 - "-bs-package-name" package_name - "-bs-ns" s - , - Ext_string.inter2 "-bs-ns" s in - let () = + | None -> + (Ext_string.inter2 "-bs-package-name" package_name, Ext_string.empty) + | Some s -> + ( Ext_string.inter4 "-bs-package-name" package_name "-bs-ns" s, + Ext_string.inter2 "-bs-ns" s ) + in + let () = Ext_option.iter pp_file (fun flag -> Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.pp_flags - (Bsb_build_util.pp_flag flag) oc - ); - Ext_option.iter gentype_config (fun x -> + (Bsb_build_util.pp_flag flag) + oc); + Ext_option.iter gentype_config (fun x -> (* resolved earlier *) Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.gentypeconfig - ("-bs-gentype " ^ x.path) oc - ); - Ext_option.iter built_in_dependency (fun x -> - Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl - (Ext_filename.maybe_quote x.package_install_path) oc - ) - ; - + ("-bs-gentype " ^ x.path) oc); + Ext_option.iter built_in_dependency (fun x -> + Bsb_ninja_targets.output_kv Bsb_ninja_global_vars.g_stdlib_incl + (Ext_filename.maybe_quote x.package_install_path) + oc); Bsb_ninja_targets.output_kvs [| - Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg ; - Bsb_ninja_global_vars.src_root_dir, per_proj_dir (* TODO: need check its integrity -- allow relocate or not? *); - (* The path to [bsc.exe] independent of config *) - Bsb_ninja_global_vars.bsc, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc); + (Bsb_ninja_global_vars.g_pkg_flg, g_pkg_flg); + (Bsb_ninja_global_vars.src_root_dir, per_proj_dir) + (* TODO: need check its integrity -- allow relocate or not? *); + (* The path to [bsc.exe] independent of config *) + ( Bsb_ninja_global_vars.bsc, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsc ); (* The path to [bsb_heler.exe] *) - Bsb_ninja_global_vars.bsdep, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep) ; - Bsb_ninja_global_vars.warnings, Bsb_warning.to_bsb_string ~toplevel warning ; - Bsb_ninja_global_vars.bsc_flags, (get_bsc_flags ~toplevel bsc_flags) ; - Bsb_ninja_global_vars.ppx_flags, ppx_flags; - - Bsb_ninja_global_vars.g_dpkg_incls, - (Bsb_build_util.include_dirs_by - bs_dev_dependencies - (fun x -> x.package_install_path)); - Bsb_ninja_global_vars.g_ns , g_ns_flg ; - Bsb_build_schemas.bsb_dir_group, "0" (*TODO: avoid name conflict in the future *) - |] oc - in - let bs_groups, bsc_lib_dirs, static_resources = - if number_of_dev_groups = 0 then - let bs_group, source_dirs,static_resources = - Ext_list.fold_left bs_file_groups (Map_string.empty,[],[]) - (fun (acc, dirs,acc_resources) ({sources ; dir; resources } as x) - -> - Bsb_db_util.merge acc sources , - (if Bsb_file_groups.is_empty x then dirs else dir::dirs) , - ( if resources = [] then acc_resources - else Ext_list.map_append resources acc_resources (fun x -> dir // x ) ) - ) in + ( Bsb_ninja_global_vars.bsdep, + Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep ); + ( Bsb_ninja_global_vars.warnings, + Bsb_warning.to_bsb_string ~toplevel warning ); + (Bsb_ninja_global_vars.bsc_flags, get_bsc_flags ~toplevel bsc_flags); + (Bsb_ninja_global_vars.ppx_flags, ppx_flags); + ( Bsb_ninja_global_vars.g_dpkg_incls, + Bsb_build_util.include_dirs_by bs_dev_dependencies (fun x -> + x.package_install_path) ); + (Bsb_ninja_global_vars.g_ns, g_ns_flg); + (Bsb_build_schemas.bsb_dir_group, "0") + (*TODO: avoid name conflict in the future *); + |] + oc + in + let bs_groups, bsc_lib_dirs, static_resources = + if number_of_dev_groups = 0 then ( + let bs_group, source_dirs, static_resources = + Ext_list.fold_left bs_file_groups (Map_string.empty, [], []) + (fun (acc, dirs, acc_resources) ({ sources; dir; resources } as x) -> + ( Bsb_db_util.merge acc sources, + (if Bsb_file_groups.is_empty x then dirs else dir :: dirs), + if resources = [] then acc_resources + else + Ext_list.map_append resources acc_resources (fun x -> dir // x) + )) + in Bsb_db_util.sanity_check bs_group; - [|bs_group|], source_dirs, static_resources + ([| bs_group |], source_dirs, static_resources) ) else - let bs_groups = Array.init (number_of_dev_groups + 1 ) (fun i -> Map_string.empty) in - let source_dirs = Array.init (number_of_dev_groups + 1 ) (fun i -> []) in + let bs_groups = + Array.init (number_of_dev_groups + 1) (fun i -> Map_string.empty) + in + let source_dirs = Array.init (number_of_dev_groups + 1) (fun i -> []) in let static_resources = - Ext_list.fold_left bs_file_groups [] (fun (acc_resources : string list) {sources; dir; resources; dir_index} - -> - let dir_index = (dir_index :> int) in - bs_groups.(dir_index) <- Bsb_db_util.merge bs_groups.(dir_index) sources ; + Ext_list.fold_left bs_file_groups [] + (fun (acc_resources : string list) + { sources; dir; resources; dir_index } + -> + let dir_index = (dir_index :> int) in + bs_groups.(dir_index) <- + Bsb_db_util.merge bs_groups.(dir_index) sources; source_dirs.(dir_index) <- dir :: source_dirs.(dir_index); - Ext_list.map_append resources acc_resources (fun x -> dir//x) - ) in - let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in + Ext_list.map_append resources acc_resources (fun x -> dir // x)) + in + let lib = bs_groups.((Bsb_dir_index.lib_dir_index :> int)) in Bsb_db_util.sanity_check lib; - for i = 1 to number_of_dev_groups do + for i = 1 to number_of_dev_groups do let c = bs_groups.(i) in Bsb_db_util.sanity_check c; - Map_string.iter c - (fun k a -> - if Map_string.mem lib k then - Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k) - ) ; - Bsb_ninja_targets.output_kv - (Bsb_dir_index.(string_of_bsb_dev_include (of_int i))) - (Bsb_build_util.include_dirs source_dirs.(i)) oc - done ; - bs_groups,source_dirs.((Bsb_dir_index.lib_dir_index:>int)), static_resources + Map_string.iter c (fun k a -> + if Map_string.mem lib k then + Bsb_db_util.conflict_module_info k a (Map_string.find_exn lib k)); + Bsb_ninja_targets.output_kv + Bsb_dir_index.(string_of_bsb_dev_include (of_int i)) + (Bsb_build_util.include_dirs source_dirs.(i)) + oc + done; + ( bs_groups, + source_dirs.((Bsb_dir_index.lib_dir_index :> int)), + static_resources ) in let digest = Bsb_db_encode.write_build_cache ~dir:cwd_lib_bs bs_groups in - let rules : Bsb_ninja_rule.builtin = - Bsb_ninja_rule.make_custom_rules - ~refmt - ~has_gentype:(gentype_config <> None) + let rules : Bsb_ninja_rule.builtin = + Bsb_ninja_rule.make_custom_rules ~refmt ~has_gentype:(gentype_config <> None) ~has_postbuild:(js_post_build_cmd <> None) - ~has_ppx:(ppx_files <> []) - ~has_pp:(pp_file <> None) + ~has_ppx:(ppx_files <> []) ~has_pp:(pp_file <> None) ~has_builtin:(built_in_dependency <> None) - ~reason_react_jsx - ~bs_suffix - ~digest - generators in - - emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace oc; - output_static_resources static_resources rules.copy_resources oc ; - (** Generate build statement for each file *) - Ext_list.iter bs_file_groups - (fun files_per_dir -> - Bsb_ninja_file_groups.handle_files_per_dir oc - ~bs_suffix - ~rules - ~js_post_build_cmd - ~package_specs - ~files_to_install - ~namespace files_per_dir) - ; + ~reason_react_jsx ~digest generators + in - Ext_option.iter namespace (fun ns -> - let namespace_dir = - per_proj_dir // Bsb_config.lib_bs in - Bsb_namespace_map_gen.output - ~dir:namespace_dir ns - bs_file_groups; - Bsb_ninja_targets.output_build oc - ~outputs:[ns ^ Literals.suffix_cmi] - ~inputs:[ns ^ Literals.suffix_mlmap] - ~rule:rules.build_package - ); + emit_bsc_lib_includes bs_dependencies bsc_lib_dirs external_includes namespace + oc; + output_static_resources static_resources rules.copy_resources oc; + (* Generate build statement for each file *) + Ext_list.iter bs_file_groups (fun files_per_dir -> + Bsb_ninja_file_groups.handle_files_per_dir oc ~rules ~js_post_build_cmd + ~package_specs ~files_to_install ~namespace files_per_dir); + + Ext_option.iter namespace (fun ns -> + let namespace_dir = per_proj_dir // Bsb_config.lib_bs in + Bsb_namespace_map_gen.output ~dir:namespace_dir ns bs_file_groups; + Bsb_ninja_targets.output_build oc + ~outputs:[ ns ^ Literals.suffix_cmi ] + ~inputs:[ ns ^ Literals.suffix_mlmap ] + ~rule:rules.build_package); close_out oc end diff --git a/lib/4.06.1/unstable/bspack.ml b/lib/4.06.1/unstable/bspack.ml index 29e31f4d55..cfb97c8535 100644 --- a/lib/4.06.1/unstable/bspack.ml +++ b/lib/4.06.1/unstable/bspack.ml @@ -9866,7 +9866,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -9884,7 +9884,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -9894,7 +9894,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -9907,9 +9907,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -9952,7 +9952,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -9962,48 +9962,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -10021,7 +10026,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -10035,7 +10040,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -10094,8 +10099,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -10103,19 +10108,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -10134,9 +10144,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ext_path : sig #1 "ext_path.mli" @@ -11209,7 +11220,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -11227,96 +11238,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - -(** return [package_name] and [path] - when in script mode: -*) - -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref +val no_builtin_ppx_mli : bool ref +val no_warn_unimplemented_external : bool ref -val no_warn_unimplemented_external : bool ref - +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -11344,83 +11333,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 601c1b6f5d..2d4dba222b 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -14128,7 +14128,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14146,96 +14146,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -14263,83 +14241,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -14359,7 +14301,7 @@ end module Bs_warnings : sig #1 "bs_warnings.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14377,29 +14319,27 @@ module Bs_warnings : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit end = struct #1 "bs_warnings.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14417,117 +14357,106 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) - - + Format.pp_print_flush warning_formatter () ) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) -(** - Note the standard way of reporting error in compiler: +(** Note the standard way of reporting error in compiler: - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error - Define an error type + Define an error type - type error - exception Error of Location.t * error + type error exception Error of Location.t * error - Provide a printer to error + Provide a printer to error - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) end module Ext_util : sig @@ -15131,7 +15060,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15149,7 +15078,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15159,7 +15088,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -15172,9 +15101,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -15217,7 +15146,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -15227,48 +15156,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15286,7 +15220,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15300,7 +15234,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -15359,8 +15293,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -15368,19 +15302,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -15399,9 +15338,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ast_attributes : sig #1 "ast_attributes.mli" @@ -75508,7 +75448,7 @@ end module Ext_namespace : sig #1 "ext_namespace.mli" (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -75526,64 +75466,38 @@ module Ext_namespace : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option - -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string end = struct #1 "ext_namespace.ml" - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -75601,115 +75515,116 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + #1933 when removing ns suffix, don't pass the bound of basename - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) + + +type leading_case = Upper | Lower + +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext + + +(** https://docs.npmjs.com/files/package.json + + Some rules: + + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. + + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = if off >= len then () - else + else let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end module Outcome_printer_ns : sig @@ -90455,8 +90370,8 @@ end = struct #1 "ext_arg.ml" let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt end -module Js_packages_info : sig -#1 "js_packages_info.mli" +module Js_package_info : sig +#1 "js_package_info.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -90481,91 +90396,56 @@ module Js_packages_info : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type module_system = NodeJS | Es6 | Es6_global -type module_system = - | NodeJS - | Es6 - | Es6_global +val runtime_dir_of_module_system : module_system -> string - -val runtime_dir_of_module_system : - module_system -> - string +val runtime_package_path : module_system -> string -> string -val runtime_package_path: - module_system -> - string -> - string - -type package_info - = - { - module_system : module_system ; - path : string - } - -type t - -val is_runtime_package: - t -> - bool - -val same_package_by_name : - t -> - t -> - bool +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} -val iter : - t -> - (package_info -> unit) -> - unit +type t -val empty : t -val from_name : string -> t -val is_empty : t -> bool +val is_runtime_package : t -> bool -val dump_packages_info : - Format.formatter -> t -> unit +val same_package_by_name : t -> t -> bool +val iter : t -> (location_descriptor -> unit) -> unit -(** used by command line option - e.g [-bs-package-output commonjs:xx/path] -*) -val add_npm_package_path : - t -> - string -> - t +val empty : t +val from_name : string -> t +val is_empty : t -> bool -type package_found_info = - { +val dump_package_info : Format.formatter -> t -> unit - rel_path : string ; - pkg_rel_path : string - } +val deprecated_set_bs_extension : unit -> unit -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info +val append_location_descriptor_of_string : t -> string -> t +(** used by command line option e.g [-bs-package-output commonjs:xx/path:ext] *) -val get_output_dir: - t -> - package_dir:string -> - module_system -> - string +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} -val query_package_infos: - t -> - module_system -> - info_query -(** Note here we compare the package info by order - in theory, we can compare it by set semantics -*) +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths +val get_output_dir : t -> package_dir:string -> module_system -> string +(* Note here we compare the package info by order in theory, we can compare it + by set semantics *) +val query_package_location_by_module_system : t -> module_system -> query_result end = struct -#1 "js_packages_info.ml" +#1 "js_package_info.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -90595,239 +90475,201 @@ end = struct type path = string type module_system = - | NodeJS + | NodeJS | Es6 - | Es6_global (* ignore node_modules, just calcluating relative path *) - - -(* ocamlopt could not optimize such simple case..*) -let compatible (dep : module_system) - (query : module_system) = - match query with - | NodeJS -> dep = NodeJS - | Es6 -> dep = Es6 - | Es6_global - -> dep = Es6_global || dep = Es6 -(* As a dependency Leaf Node, it is the same either [global] or [not] *) - - -type package_info = - { module_system : module_system ; path : string } - -type package_name = - | Pkg_empty - | Pkg_runtime - | Pkg_normal of string + (* ignore node_modules, just calcluating relative path *) + | Es6_global + +(* ocamlopt could not optimize such simple case... *) +let compatible (dep : module_system) (query : module_system) = + match query with + | NodeJS -> dep = NodeJS + | Es6 -> dep = Es6 + (* As a dependency Leaf Node, it is the same either [global] or [not] *) + | Es6_global -> dep = Es6_global || dep = Es6 + + +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} +type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string +let deprecated_use_bs_extension = ref false let runtime_package_name = "bs-platform" +let ( // ) = Filename.concat -let (//) = Filename.concat - -(* in runtime lib, [es6] and [es6] are treated the same wway *) -let runtime_dir_of_module_system (ms : module_system ) = - match ms with +(* in runtime lib, [es6] and [es6-global] are treated the same way *) +let runtime_dir_of_module_system (ms : module_system) = + match ms with | NodeJS -> "js" | Es6 | Es6_global -> "es6" -let runtime_package_path - (ms : module_system) - js_file = - runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file - -type t = - { - name : package_name ; - module_systems: package_info list - } +let runtime_package_path (ms : module_system) js_file = + runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file -let same_package_by_name (x : t) (y : t) = x.name = y.name -let is_runtime_package (x : t) = - x.name = Pkg_runtime +type t = { name : package_name; locations : location_descriptor list } -let iter (x : t) cb = - Ext_list.iter x.module_systems cb +let same_package_by_name (x : t) (y : t) = x.name = y.name -(* let equal (x : t) ({name; module_systems}) = - x.name = name && - Ext_list.for_all2_no_exn - x.module_systems module_systems - (fun (a0,a1) (b0,b1) -> a0 = b0 && a1 = b1) *) +let is_runtime_package (x : t) = x.name = Pkg_runtime -(* we don't want force people to use package *) +let iter (x : t) = Ext_list.iter x.locations -(** - TODO: not allowing user to provide such specific package name - For empty package, [-bs-package-output] does not make sense - it is only allowed to generate commonjs file in the same directory -*) -let empty : t = - { name = Pkg_empty ; - module_systems = [] - } +(* TODO: not allowing user to provide such specific package name For empty + package, [-bs-package-output] does not make sense it is only allowed to + generate commonjs file in the same directory *) +let empty : t = { name = Pkg_empty; locations = [] } let from_name (name : string) = - if name = runtime_package_name then - { - name = Pkg_runtime ; module_systems = [] - } - else - { - name = Pkg_normal name ; - module_systems = [] - } + if name = runtime_package_name then { name = Pkg_runtime; locations = [] } + else { name = Pkg_normal name; locations = [] } -let is_empty (x : t) = - x.name = Pkg_empty - -let string_of_module_system (ms : module_system) = - match ms with +let is_empty (x : t) = x.name = Pkg_empty + +let string_of_module_system (ms : module_system) = + match ms with | NodeJS -> "NodeJS" | Es6 -> "Es6" | Es6_global -> "Es6_global" - -let module_system_of_string package_name : module_system option = + +let module_system_of_string package_name : module_system option = match package_name with | "commonjs" -> Some NodeJS | "es6" -> Some Es6 | "es6-global" -> Some Es6_global - | _ -> None + | _ -> None -let dump_package_info - (fmt : Format.formatter) - ({module_system = ms; path = name} : package_info) - = - Format.fprintf - fmt - "@[%s:@ %s@]" + +let dump_location_descriptor (fmt : Format.formatter) + { module_system = ms; path; extension } = + Format.fprintf fmt "@[%s:@ %s:@ %s@]" (string_of_module_system ms) - name + path extension -let dump_package_name fmt (x : package_name) = - match x with + +let dump_package_name fmt (x : package_name) = + match x with | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" - | Pkg_normal s -> Format.pp_print_string fmt s + | Pkg_normal s -> Format.pp_print_string fmt s | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name -let dump_packages_info - (fmt : Format.formatter) - ({name ; module_systems = ls } : t) = - Format.fprintf fmt "@[%a;@ @[%a@]@]" - dump_package_name - name + +let dump_package_info (fmt : Format.formatter) ({ name; locations } : t) = + Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) - dump_package_info - ) ls + dump_location_descriptor) + locations -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -(* Note that package-name has to be exactly the same as - npm package name, otherwise the path resolution will be wrong *) -let query_package_infos - ({name; module_systems } : t) - (module_system : module_system) : info_query = - match name with - | Pkg_empty -> - Package_script - | Pkg_normal name -> - (match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found) - | Pkg_runtime -> - match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = runtime_package_name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +(* Note that package-name has to be exactly the same as npm package name, + otherwise the path resolution will be wrong *) +let query_package_location_by_module_system ({ name; locations } : t) + (module_system : module_system) : query_result = + match name with + | Pkg_empty -> Package_script + | Pkg_normal name -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + | Pkg_runtime -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = runtime_package_name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) -let get_js_path - (x : t ) - module_system - = - match Ext_list.find_first x.module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> k.path +let get_js_path (x : t) module_system = + match + Ext_list.find_first x.locations (fun k -> + compatible k.module_system module_system) + with + | Some k -> k.path | None -> assert false -(* for a single pass compilation, [output_dir] - can be cached -*) -let get_output_dir - (info: t ) - ~package_dir module_system - = - Filename.concat package_dir - (get_js_path info module_system) +(* for a single pass compilation, [output_dir] can be cached *) +let get_output_dir (info : t) ~package_dir module_system = + Filename.concat package_dir (get_js_path info module_system) +let deprecated_set_bs_extension () = + Bs_warnings.warn_deprecated_bs_suffix_flag (); + deprecated_use_bs_extension := true -let add_npm_package_path (packages_info : t) (s : string) : t = - if is_empty packages_info then - Ext_arg.bad_argf "please set package name first using -bs-package-name " - else - let module_system, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ module_system; path] -> - (match module_system_of_string module_system with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" module_system), path - | [path] -> - NodeJS, path - | module_system :: path -> - (match module_system_of_string module_system with - | Some x -> x - | None -> Ext_arg.bad_argf "invalid module system %s" module_system), (String.concat ":" path) - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - { packages_info with module_systems = {module_system; path}::packages_info.module_systems} + +let deprecated_get_default_extension () = + if !deprecated_use_bs_extension then Literals.suffix_bs_js + else Literals.suffix_js + + +(* FIXME: The deprecated -bs-suffix will only affect -bs-package-output flags + passed *after* it. *) +let append_location_descriptor_of_string (packages_info : t) (s : string) : t = + let module_system, path, extension = + match Ext_string.split ~keep_empty:false s ':' with + | [ module_system; path; extension ] -> (module_system, path, extension) + (* Note that, for most users, the default values for [module_system] and + [extension] come not from here, but from [bsb], which always invokes this + with a fully-populated [-bs-package-output]. + + If you're changing the default, make sure both places match! *) + | [ module_system; path ] -> + (module_system, path, deprecated_get_default_extension ()) + | [ path ] -> ("NodeJS", path, deprecated_get_default_extension ()) + | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s + in + let module_system = + match module_system_of_string module_system with + | Some x -> x + | None -> + Ext_arg.bad_argf "invalid module system in -bs-package-output: %s" + module_system + in + { + packages_info with + locations = { module_system; path; extension } :: packages_info.locations; + } (* support es6 modules instead - TODO: enrich ast to support import export - http://www.ecma-international.org/ecma-262/6.0/#sec-imports - For every module, we need [Ident.t] for accessing and [filename] for import, - they are not necessarily the same. - Es6 modules is not the same with commonjs, we use commonjs currently - (play better with node) + TODO: enrich ast to support import export + http://www.ecma-international.org/ecma-262/6.0/#sec-imports For every module, + we need [Ident.t] for accessing and [filename] for import, they are not + necessarily the same. - FIXME: the module order matters? -*) + Es6 modules is not the same with commonjs, we use commonjs currently (play + better with node) + FIXME: the module order matters? *) end module Lam_compat : sig @@ -93609,7 +93451,7 @@ end module Js_cmj_format : sig #1 "js_cmj_format.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -93627,102 +93469,69 @@ module Js_cmj_format : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** Define intemediate format to be serialized for cross module optimization *) +(** In this module, currently only arity information is exported, + - Short term: constant literals are also exported + - Long term: Benefit? since Google Closure Compiler already did such huge + amount of work + TODO: simple expression, literal small function can be stored, but what + would happen if small function captures other environment, for example + {[ let f x = g x ]} + {[ let f = g ]} *) - - -(** Define intemediate format to be serialized for cross module optimization - *) - -(** In this module, - currently only arity information is exported, - - Short term: constant literals are also exported - - Long term: - Benefit? since Google Closure Compiler already did such huge amount of work - TODO: simple expression, literal small function can be stored, - but what would happen if small function captures other environment - for example - - {[ - let f = fun x -> g x - ]} - - {[ - let f = g - ]} -*) - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (* Either constant or closed functor *) + arity : arity; + persistent_closed_lambda : Lam.t option; + (* Either constant or closed functor *) } type effect = string option -type cmj_case = Ext_namespace.file_kind - -type t - +type t -val mk: - values: cmj_value Map_string.t -> - effect: effect -> - npm_package_path: Js_packages_info.t -> - cmj_case:cmj_case -> +val mk : + values:cmj_value Map_string.t -> + effect:effect -> + package_info:Js_package_info.t -> + leading_case:Ext_namespace.leading_case -> t -val query_by_name : - t -> - string -> - arity * Lam.t option +val query_by_name : t -> string -> arity * Lam.t option -val is_pure : - t -> bool +val is_pure : t -> bool -val get_npm_package_path : - t -> - Js_packages_info.t +val get_package_info : t -> Js_package_info.t -val get_cmj_case : - t -> - cmj_case +val get_leading_case : t -> Ext_namespace.leading_case val single_na : arity - - val from_file : string -> t -val from_file_with_digest : - string -> t * Digest.t +val from_file_with_digest : string -> t * Digest.t val from_string : string -> t -(* Note writing the file if its content is not chnaged -*) -val to_file : - string -> check_exists:bool -> t -> unit +(* Note writing the file if its content is not chnaged *) +val to_file : string -> check_exists:bool -> t -> unit + +val pp_cmj : t -> unit -val pp_cmj: t -> unit end = struct #1 "js_cmj_format.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -93740,233 +93549,204 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - [@@@ocaml.warning "+9"] - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array (* TODO: add a magic number *) -type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (** Either constant or closed functor *) -} +type cmj_value = { arity : arity; persistent_closed_lambda : Lam.t option } type effect = string option - +(* we don't force people to use package *) let single_na = Single Lam_arity.na -(** we don't force people to use package *) -type cmj_case = Ext_namespace.file_kind - -type keyed_cmj_values - = (string * cmj_value) array + +type keyed_cmj_values = (string * cmj_value) array type t = { - values : keyed_cmj_values ; + values : keyed_cmj_values; pure : bool; - npm_package_path : Js_packages_info.t ; - cmj_case : cmj_case; + package_info : Js_package_info.t; + leading_case : Ext_namespace.leading_case; } + let empty_values = [||] -let mk ~values ~effect ~npm_package_path ~cmj_case : t = + +let mk ~values ~effect ~package_info ~leading_case : t = { - values = Map_string.to_sorted_array values; - pure = effect = None ; - npm_package_path; - cmj_case + values = Map_string.to_sorted_array values; + pure = effect = None; + package_info; + leading_case; } -let cmj_magic_number = "BUCKLE20171012" -let cmj_magic_number_length = - String.length cmj_magic_number - +let cmj_magic_number = "BUCKLE20200410" +let cmj_magic_number_length = String.length cmj_magic_number let digest_length = 16 (*16 chars *) let verify_magic_in_beg ic = - let buffer = really_input_string ic cmj_magic_number_length in + let buffer = really_input_string ic cmj_magic_number_length in if buffer <> cmj_magic_number then - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ (* Serialization .. *) let from_file name : t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let _digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v + let ic = open_in_bin name in + verify_magic_in_beg ic; + let _digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + v + let from_file_with_digest name : t * Digest.t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v,digest - - -let from_string s : t = - let magic_number = String.sub s 0 cmj_magic_number_length in - if magic_number = cmj_magic_number then - Marshal.from_string s (digest_length + cmj_magic_number_length) - else - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + let ic = open_in_bin name in + verify_magic_in_beg ic; + let digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + (v, digest) + + +let from_string s : t = + let magic_number = String.sub s 0 cmj_magic_number_length in + if magic_number = cmj_magic_number then + Marshal.from_string s (digest_length + cmj_magic_number_length) + else + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ + let fixed_length = cmj_magic_number_length + digest_length -let rec for_sure_not_changed (name : string) (header : string) = - if Sys.file_exists name then - let ic = open_in_bin name in - let holder = - really_input_string ic fixed_length in - close_in ic; - holder = header - else false - -(* This may cause some build system always rebuild - maybe should not be turned on by default -*) -let to_file name ~check_exists (v : t) = - let s = Marshal.to_string v [] in - let cur_digest = Digest.string s in - let header = cmj_magic_number ^ cur_digest in - if not (check_exists && for_sure_not_changed name header) then - let oc = open_out_bin name in - output_string oc header; +let rec for_sure_not_changed (name : string) (header : string) = + if Sys.file_exists name then ( + let ic = open_in_bin name in + let holder = really_input_string ic fixed_length in + close_in ic; + holder = header ) + else false + + +(* This may cause some build system always rebuild maybe should not be turned on + by default *) +let to_file name ~check_exists (v : t) = + let s = Marshal.to_string v [] in + let cur_digest = Digest.string s in + let header = cmj_magic_number ^ cur_digest in + if not (check_exists && for_sure_not_changed name header) then ( + let oc = open_out_bin name in + output_string oc header; output_string oc s; - close_out oc - -let keyComp (a : string) (b,_) = - Map_string.compare_key a b - -let not_found = single_na, None -let get_result midVal = - let (_,cmj_value) = midVal in - cmj_value.arity, - if Js_config.get_cross_module_inline () then cmj_value.persistent_closed_lambda - else None - -let rec binarySearchAux arr lo hi (key : string) = - let mid = (lo + hi)/2 in - let midVal = Array.unsafe_get arr mid in - let c = keyComp key midVal in - if c = 0 then - get_result midVal - else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let loVal = (Array.unsafe_get arr lo) in - if fst loVal = key then get_result loVal - else not_found - else binarySearchAux arr lo mid key - else (* a[lo] =< a[mid] < key <= a[hi] *) - if lo = mid then - let hiVal = (Array.unsafe_get arr hi) in - if fst hiVal = key then get_result hiVal - else not_found + close_out oc ) + + +let keyComp (a : string) (b, _) = Map_string.compare_key a b + +let not_found = (single_na, None) +let get_result midVal = + let _, cmj_value = midVal in + ( cmj_value.arity, + if Js_config.get_cross_module_inline () then + cmj_value.persistent_closed_lambda + else None ) + + +let rec binarySearchAux arr lo hi (key : string) = + let mid = (lo + hi) / 2 in + let midVal = Array.unsafe_get arr mid in + let c = keyComp key midVal in + if c = 0 then get_result midVal + else if c < 0 then + (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = Array.unsafe_get arr lo in + if fst loVal = key then get_result loVal else not_found + else binarySearchAux arr lo mid key + else if (* a[lo] =< a[mid] < key <= a[hi] *) + lo = mid then + let hiVal = Array.unsafe_get arr hi in + if fst hiVal = key then get_result hiVal else not_found else binarySearchAux arr mid hi key -let binarySearch (sorted : keyed_cmj_values) (key : string) = - let len = Array.length sorted in + +let binarySearch (sorted : keyed_cmj_values) (key : string) = + let len = Array.length sorted in if len = 0 then not_found - else - let lo = Array.unsafe_get sorted 0 in - let c = keyComp key lo in + else + let lo = Array.unsafe_get sorted 0 in + let c = keyComp key lo in if c < 0 then not_found else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = keyComp key hi in - if c2 > 0 then not_found - else binarySearchAux sorted 0 (len - 1) key + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = keyComp key hi in + if c2 > 0 then not_found else binarySearchAux sorted 0 (len - 1) key -(* FIXME: better error message when ocamldep - get self-cycle -*) -let query_by_name (cmj_table : t ) name = - let values = cmj_table.values in - binarySearch values name +(* FIXME: better error message when ocamldep get self-cycle *) +let query_by_name (cmj_table : t) name = + let values = cmj_table.values in + binarySearch values name -let is_pure (cmj_table : t ) = - cmj_table.pure -let get_npm_package_path (cmj_table : t) = - cmj_table.npm_package_path +let is_pure (cmj_table : t) = cmj_table.pure -let get_cmj_case (cmj_table : t) = - cmj_table.cmj_case +let get_package_info (cmj_table : t) = cmj_table.package_info +let get_leading_case (cmj_table : t) = cmj_table.leading_case (* start dumping *) -let f fmt = Printf.fprintf stdout fmt - -let pp_cmj_case (cmj_case : cmj_case) : unit = - match cmj_case with - | Little_js -> - f "case : little, .js \n" - | Little_bs -> - f "case : little, .bs.js \n" - | Upper_js -> - f "case: upper, .js \n" - | Upper_bs -> - f "case: upper, .bs.js \n" - -let pp_cmj - ({ values ; pure; npm_package_path ; cmj_case} : t) = - f "package info: %s\n" - (Format.asprintf "%a" Js_packages_info.dump_packages_info npm_package_path) - ; - pp_cmj_case cmj_case; - - f "effect: %s\n" - (if pure then "pure" else "not pure"); - Ext_array.iter values - (fun (k , {arity; persistent_closed_lambda}) -> - match arity with - | Single arity -> - f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); - (match persistent_closed_lambda with - | None -> - f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; +let f fmt = Printf.fprintf stdout fmt + +let pp_leading_case (leading_case : Ext_namespace.leading_case) : unit = + match leading_case with + | Upper -> f "case: upper\n" + | Lower -> f "case: lower\n" + + +let pp_cmj ({ values; pure; package_info; leading_case } : t) = + f "package info: %s\n" + (Format.asprintf "%a" Js_package_info.dump_package_info package_info); + pp_leading_case leading_case; + + f "effect: %s\n" (if pure then "pure" else "not pure"); + Ext_array.iter values (fun (k, { arity; persistent_closed_lambda }) -> + match arity with + | Single arity -> ( + f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); + match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s\n" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end ) - | Submodule xs -> - (match persistent_closed_lambda with - | None -> f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; + f "%s: ======[finish]\n" k ) + | Submodule xs -> + ( match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end - ); - Array.iteri - (fun i arity -> f "%s[%i] : %s \n" - k i - (Format.asprintf "%a" Lam_arity.print arity )) - xs - ) + f "%s: ======[finish]\n" k ); + Array.iteri + (fun i arity -> + f "%s[%i] : %s \n" k i + (Format.asprintf "%a" Lam_arity.print arity)) + xs) + end module Js_cmj_datasets : sig #1 "js_cmj_datasets.mli" @@ -103023,6 +102803,7 @@ val imports : Ext_pp.t -> (Ident.t * string) list -> Ext_pp_scope.t + end = struct #1 "js_dump_import_export.ml" (* Copyright (C) 2017 Authors of BuckleScript @@ -103907,8 +103688,8 @@ let find_package_json_dir cwd = let package_dir = lazy (find_package_json_dir (Lazy.force cwd)) end -module Js_packages_state : sig -#1 "js_packages_state.mli" +module Js_current_package_info : sig +#1 "js_current_package_info.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -103933,19 +103714,16 @@ module Js_packages_state : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val set_package_name : string -> unit +val set_package_map : string -> unit -val set_package_name : string -> unit +val get_packages_info : unit -> Js_package_info.t -val set_package_map : string -> unit +val append_location_descriptor_of_string : string -> unit -val get_packages_info : - unit -> Js_packages_info.t - -val update_npm_package_path : - string -> unit end = struct -#1 "js_packages_state.ml" +#1 "js_current_package_info.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -103970,30 +103748,27 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let packages_info = ref Js_package_info.empty + +let set_package_name name = + if Js_package_info.is_empty !packages_info then + packages_info := Js_package_info.from_name name + else Ext_arg.bad_argf "duplicated flag for -bs-package-name" -let packages_info = ref Js_packages_info.empty +let set_package_map module_name = + Clflags.dont_record_crc_unit := Some module_name; + Clflags.open_modules := module_name :: !Clflags.open_modules -let set_package_name name = - if Js_packages_info.is_empty !packages_info then - packages_info := Js_packages_info.from_name name +let append_location_descriptor_of_string s = + if Js_package_info.is_empty !packages_info then + Ext_arg.bad_argf "please set package name first using -bs-package-name or -bs-ns" else - Ext_arg.bad_argf "duplicated flag for -bs-package-name" - -let set_package_map module_name = - (* set_package_name name ; - let module_name = Ext_namespace.namespace_of_package_name name in *) - Clflags.dont_record_crc_unit := Some module_name; - Clflags.open_modules := - module_name:: - !Clflags.open_modules - -let update_npm_package_path s = - packages_info := - Js_packages_info.add_npm_package_path !packages_info s + packages_info := Js_package_info.append_location_descriptor_of_string !packages_info s + +let get_packages_info () = !packages_info -let get_packages_info () = !packages_info end module Ext_modulename : sig #1 "ext_modulename.mli" @@ -104320,7 +104095,7 @@ val find_cmj_exn : end = struct #1 "js_cmj_load.ml" (* Copyright (C) Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -104338,41 +104113,35 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* strategy: - If not installed, use the distributed [cmj] files, - make sure that the distributed files are platform independent -*) +(* strategy: If not installed, use the distributed [cmj] files, make sure that + the distributed files are platform independent *) +type path = string +type cmj_load_info = { cmj_table : Js_cmj_format.t; cmj_path : path } -type path = string -type cmj_load_info = { - cmj_table : Js_cmj_format.t ; - cmj_path : path ; -} - -let find_cmj_exn file : cmj_load_info = +let find_cmj_exn file : cmj_load_info = let target = Ext_string.uncapitalize_ascii (Filename.basename file) in match Map_string.find_exn !Js_cmj_datasets.data_sets target with - | v - -> - begin match Lazy.force v with - | exception _ - -> - Ext_log.warn __LOC__ - "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target !Location.input_name ; - Bs_exception.error (Cmj_not_found file) - | v -> {cmj_path = "BROWSER"; cmj_table = v} - (* see {!Js_packages_info.string_of_module_id} *) - end - | exception Not_found - -> - Bs_exception.error (Cmj_not_found file) + | v -> ( + match Lazy.force v with + | exception _ -> + Ext_log.warn __LOC__ + "@[%s corrupted in database, when looking %s while compiling %s \ + please update @]" + file target !Location.input_name; + Bs_exception.error (Cmj_not_found file) + | v -> + { cmj_path = "BROWSER"; cmj_table = v } + (* see {!Js_package_info.string_of_module_id} *) ) + | exception Not_found -> Bs_exception.error (Cmj_not_found file) + + end module Hash : sig @@ -109432,7 +109201,7 @@ end module Lam_compile_env : sig #1 "lam_compile_env.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109450,96 +109219,69 @@ module Lam_compile_env : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** Helper for global Ocaml module index into meaningful names *) - - - - +(** Helper for global Ocaml module index into meaningful names *) type ident_info = { name : string; arity : Js_cmj_format.arity; - closed_lambda : Lam.t option -} + closed_lambda : Lam.t option; +} +val reset : unit -> unit +val add_js_module : External_ffi_types.module_bind_name -> string -> Ident.t +(** [add_js_module hint_name module_name] Given a js module name and hint name, + assign an id to it we also bookkeep it as [External] dependency. + Note the complexity lies in that we should consolidate all same external + dependencies into a single dependency. -val reset : unit -> unit + The strategy is that we first create a [Lam_module_ident.t] and query it if + already exists in [cache_tbl], if it already exists, we discard the freshly + made one, and use the cached one, otherwise, use the freshly made one + instead -(** - [add_js_module hint_name module_name] - Given a js module name and hint name, assign an id to it - we also bookkeep it as [External] dependency. + Invariant: any [id] as long as put in the [cached_tbl] should be always + valid, *) - Note the complexity lies in that we should consolidate all - same external dependencies into a single dependency. - - The strategy is that we first create a [Lam_module_ident.t] - and query it if already exists in [cache_tbl], if it already - exists, we discard the freshly made one, and use the cached one, - otherwise, use the freshly made one instead +(* The other dependencies are captured by querying either when [access] or when + expansion, however such dependency can be removed after inlining etc. - Invariant: - any [id] as long as put in the [cached_tbl] should be always valid, -*) -val add_js_module : - External_ffi_types.module_bind_name -> string -> Ident.t + When we register such compile time dependency we classified it as Visit (ml), + Builtin(built in js), External() + For external, we never remove, we only consider remove dependency for Runtime + and Visit, so when compile OCaml to Javascript, we only need pay attention to + for those modules are actually used or not *) -(* The other dependencies are captured by querying - either when [access] or when expansion, - however such dependency can be removed after inlining etc. - - When we register such compile time dependency we classified - it as - Visit (ml), Builtin(built in js), External() - - For external, we never remove, we only consider - remove dependency for Runtime and Visit, so - when compile OCaml to Javascript, we only need - pay attention to for those modules are actually used or not -*) -(** - [query_external_id_info id pos env found] - will raise if not found -*) -val query_external_id_info : - Ident.t -> - string -> - ident_info - +val query_external_id_info : Ident.t -> string -> ident_info +(** [query_external_id_info id pos env found] will raise if not found *) val is_pure_module : Lam_module_ident.t -> bool +val get_package_path_from_cmj : + Lam_module_ident.t -> string * Js_package_info.t * Ext_namespace.leading_case -val get_package_path_from_cmj : - Lam_module_ident.t -> - (string * Js_packages_info.t * Js_cmj_format.cmj_case) - - +val get_required_modules : + Lam_module_ident.Hash_set.t -> + Lam_module_ident.Hash_set.t -> + Lam_module_ident.t list +(** The second argument is mostly from [runtime] modules -(* The second argument is mostly from [runtime] modules will change the input [hard_dependencies] - [get_required_modules extra hard_dependencies] - [extra] maybe removed if it is pure and not in [hard_dependencies] -*) -val get_required_modules : - Lam_module_ident.Hash_set.t -> - Lam_module_ident.Hash_set.t -> - Lam_module_ident.t list + + [get_required_modules extra hard_dependencies] - [extra] maybe removed if it + is pure and not in [hard_dependencies] *) end = struct #1 "lam_compile_env.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109557,206 +109299,141 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - - -module E = Js_exp_make +module E = Js_exp_make module S = Js_stmt_make - -type env_value = +type env_value = | Ml of Js_cmj_load.cmj_load_info - | Runtime of Js_cmj_load.cmj_load_info - (** - [Runtime (pure, path, cmj_format)] - A built in module probably from our runtime primitives, - so it does not have any [signature] - - *) - | External - (** Also a js file, but this belong to third party - *) - - - + | Runtime of Js_cmj_load.cmj_load_info + (** [Runtime (pure, path, cmj_format)] A built in module probably from our + runtime primitives, so it does not have any [signature] *) + | External (** Also a js file, but this belong to third party *) type ident_info = { name : string; - arity : Js_cmj_format.arity; - closed_lambda : Lam.t option + arity : Js_cmj_format.arity; + closed_lambda : Lam.t option; } -(* - refer: [Env.find_pers_struct] - [ find_in_path_uncap !load_path (name ^ ".cmi")] -*) +(* refer: [Env.find_pers_struct] [ find_in_path_uncap !load_path (name ^ + ".cmi")] *) +let cached_tbl : env_value Lam_module_ident.Hash.t = + Lam_module_ident.Hash.create 31 -let cached_tbl : env_value Lam_module_ident.Hash.t - = Lam_module_ident.Hash.create 31 -let (+>) = Lam_module_ident.Hash.add cached_tbl - +let ( +> ) = Lam_module_ident.Hash.add cached_tbl (* For each compilation we need reset to make it re-entrant *) -let reset () = +let reset () = Translmod.reset (); - Lam_module_ident.Hash.clear cached_tbl - - - - - -(** We should not provide "#moduleid" as output - since when we print it in the end, it will - be escaped quite ugly -*) -let add_js_module - (hint_name : External_ffi_types.module_bind_name) - (module_name : string) : Ident.t - = - let id = - Ident.create - (match hint_name with - | Phint_name hint_name -> - Ext_string.capitalize_ascii hint_name - (* make sure the module name is capitalized - TODO: maybe a warning if the user hint is not good - *) - | Phint_nothing -> - Ext_modulename.js_id_name_of_hint_name module_name - ) - in - let lam_module_ident = - Lam_module_ident.of_external id module_name in - match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with + Lam_module_ident.Hash.clear cached_tbl + + +(** We should not provide "#moduleid" as output since when we print it in the + end, it will be escaped quite ugly *) +let add_js_module (hint_name : External_ffi_types.module_bind_name) + (module_name : string) : Ident.t = + let id = + Ident.create + ( match hint_name with + | Phint_name hint_name -> Ext_string.capitalize_ascii hint_name + (* make sure the module name is capitalized TODO: maybe a warning if the + user hint is not good *) + | Phint_nothing -> Ext_modulename.js_id_name_of_hint_name module_name ) + in + let lam_module_ident = Lam_module_ident.of_external id module_name in + match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with | None -> - Lam_module_ident.Hash.add - cached_tbl - lam_module_ident - External; - id - | Some old_key -> - old_key.id - - - - + Lam_module_ident.Hash.add cached_tbl lam_module_ident External; + id + | Some old_key -> old_key.id let query_external_id_info (module_id : Ident.t) (name : string) : ident_info = - let oid = Lam_module_ident.of_ml module_id in - let cmj_table = - match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - let cmj_load_info = - Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in - oid +> Ml cmj_load_info ; - cmj_load_info.cmj_table - | Some (Ml { cmj_table } ) - -> cmj_table + let oid = Lam_module_ident.of_ml module_id in + let cmj_table = + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> + let cmj_load_info = + Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) + in + oid +> Ml cmj_load_info; + cmj_load_info.cmj_table + | Some (Ml { cmj_table }) -> cmj_table | Some (Runtime _) -> assert false - | Some External -> assert false in - let arity , closed_lambda = - Js_cmj_format.query_by_name cmj_table name + | Some External -> assert false in - { - name; - arity; - closed_lambda - (* TODO shall we cache the arity ?*) - } - - - - - - - + let arity, closed_lambda = Js_cmj_format.query_by_name cmj_table name in + { name; arity; closed_lambda (* TODO shall we cache the arity ?*) } +let get_package_path_from_cmj (id : Lam_module_ident.t) = + match Lam_module_ident.Hash.find_opt cached_tbl id with + | Some (Ml { cmj_table; cmj_path }) -> + ( cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) + | Some (External | Runtime _) -> + assert false + (* called by {!Js_name_of_module_id.string_of_module_id} can not be + External *) + | None -> ( + match id.kind with + | Runtime | External _ -> assert false + | Ml -> + let ({ Js_cmj_load.cmj_table } as cmj_load_info) = + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name id ^ Literals.suffix_cmj) + in + id +> Ml cmj_load_info; + ( cmj_load_info.cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) ) -let get_package_path_from_cmj - ( id : Lam_module_ident.t) - = - match Lam_module_ident.Hash.find_opt cached_tbl id with - | Some (Ml {cmj_table ; cmj_path}) -> - (cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - | Some ( - External | - Runtime _ ) -> - assert false - (* called by {!Js_name_of_module_id.string_of_module_id} - can not be External - *) - | None -> - begin match id.kind with - | Runtime - | External _ -> assert false - | Ml -> - let ({Js_cmj_load.cmj_table} as cmj_load_info) = - Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in - id +> Ml cmj_load_info; - (cmj_load_info.cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - end - let add = Lam_module_ident.Hash_set.add - - (* Conservative interface *) -let is_pure_module (oid : Lam_module_ident.t) = - match oid.kind with - | Runtime -> true +let is_pure_module (oid : Lam_module_ident.t) = + match oid.kind with + | Runtime -> true | External _ -> false - | Ml -> - begin match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - begin - match Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) with - | cmj_load_info -> - oid +> Ml cmj_load_info ; - Js_cmj_format.is_pure cmj_load_info.cmj_table - | exception _ -> false - end - | Some (Ml{cmj_table}|Runtime {cmj_table}) -> - Js_cmj_format.is_pure cmj_table - | Some External -> false - end - + | Ml -> ( + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> ( + match + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name oid ^ Literals.suffix_cmj) + with + | cmj_load_info -> + oid +> Ml cmj_load_info; + Js_cmj_format.is_pure cmj_load_info.cmj_table + | exception _ -> false ) + | Some (Ml { cmj_table } | Runtime { cmj_table }) -> + Js_cmj_format.is_pure cmj_table + | Some External -> false ) -let get_required_modules - extras - (hard_dependencies - : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list = - Lam_module_ident.Hash.iter cached_tbl (fun id _ -> - if not @@ is_pure_module id - then add hard_dependencies id); - Lam_module_ident.Hash_set.iter extras (fun id -> - (if not @@ is_pure_module id - then add hard_dependencies id : unit) - ); + +let get_required_modules extras + (hard_dependencies : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list + = + Lam_module_ident.Hash.iter cached_tbl (fun id _ -> + if not @@ is_pure_module id then add hard_dependencies id); + Lam_module_ident.Hash_set.iter extras (fun id -> + (if not @@ is_pure_module id then add hard_dependencies id : unit)); Lam_module_ident.Hash_set.elements hard_dependencies end module Js_name_of_module_id : sig #1 "js_name_of_module_id.mli" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109774,29 +109451,27 @@ module Js_name_of_module_id : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** - generate the mdoule path so that it can be spliced here: - {[ - var Xx = require("package/path/to/xx.js") - ]} - Note that it has to be consistent to how it is generated -*) - -val string_of_module_id : +val string_of_module_id : Lam_module_ident.t -> output_dir:string -> - Js_packages_info.module_system -> + ext:string -> + Js_package_info.module_system -> string +(** generate the mdoule path so that it can be spliced here: + + {[ var Xx = require "package/path/to/xx.js" ]} + + Note that it has to be consistent to how it is generated *) + end = struct #1 "js_name_of_module_id.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109814,195 +109489,182 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* -let (=) (x : int) (y:float) = assert false -*) -(* "xx/lib/ocaml/js.cmj" - Enhancement: This can be delegated to build system -*) -let runtime_package_path : string Lazy.t = - lazy (Filename.dirname (Filename.dirname - (Filename.dirname - (match Config_util.find_opt "js.cmj" with - | None -> assert false - | Some x -> x)))) +(* "xx/lib/ocaml/js.cmj" Enhancement: This can be delegated to build system *) +let runtime_package_path : string Lazy.t = + lazy + (Filename.dirname + (Filename.dirname + (Filename.dirname + ( match Config_util.find_opt "js.cmj" with + | None -> assert false + | Some x -> x )))) -let (//) = Filename.concat +let ( // ) = Filename.concat -let fix_path_for_windows : string -> string = +let fix_path_for_windows : string -> string = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_backward_slash - else fun s -> s - - -let get_runtime_module_path - (dep_module_id : Lam_module_ident.t) - (current_package_info : Js_packages_info.t) - module_system = - let current_info_query = - Js_packages_info.query_package_infos current_package_info - module_system in - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name Little_js in - match current_info_query with - | Package_not_found -> assert false - | Package_script -> - Js_packages_info.runtime_package_path module_system js_file - | Package_found pkg -> - let dep_path = - "lib" // Js_packages_info.runtime_dir_of_module_system module_system in - if Js_packages_info.is_runtime_package current_package_info then - Ext_path.node_rebase_file - ~from:pkg.rel_path - ~to_:dep_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - match module_system with - | NodeJS | Es6 -> - Js_packages_info.runtime_package_path module_system js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system ) - (Lazy.force runtime_package_path // dep_path // js_file) + else fun s -> s +let get_runtime_module_path (dep_module_id : Lam_module_ident.t) + (current_package_info : Js_package_info.t) module_system = + let loc = + Js_package_info.query_package_location_by_module_system current_package_info + module_system + in + let js_file = + Ext_namespace.js_filename_of_modulename ~name:dep_module_id.id.name + ~ext:".js" Lower + in + match loc with + | Package_not_found -> assert false + | Package_script -> Js_package_info.runtime_package_path module_system js_file + | Package_found pkg -> ( + let dep_path = + "lib" // Js_package_info.runtime_dir_of_module_system module_system + in + if Js_package_info.is_runtime_package current_package_info then + Ext_path.node_rebase_file ~from:pkg.rel_path ~to_:dep_path js_file + (* TODO: we assume that both [x] and [path] could only be relative path + which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + Js_package_info.runtime_package_path module_system js_file + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package path + calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + (Lazy.force runtime_package_path // dep_path // js_file) ) + (* [output_dir] is decided by the command line argument *) -let string_of_module_id - (dep_module_id : Lam_module_ident.t) - ~(output_dir : string ) - (module_system : Js_packages_info.module_system) - : string = - let current_package_info = Js_packages_state.get_packages_info () in - fix_path_for_windows ( - match dep_module_id.kind with +let string_of_module_id (dep_module_id : Lam_module_ident.t) + ~(output_dir : string) ~(ext : string) + (module_system : Js_package_info.module_system) : string = + let current_package_info = Js_current_package_info.get_packages_info () in + fix_path_for_windows + ( match dep_module_id.kind with | External name -> name (* the literal string for external package *) - (** This may not be enough, - 1. For cross packages, we may need settle - down a single js package - 2. We may need es6 path for dead code elimination - But frankly, very few JS packages have no dependency, - so having plugin may sound not that bad - *) - | Runtime -> - get_runtime_module_path dep_module_id current_package_info module_system - | Ml -> - let current_info_query = - Js_packages_info.query_package_infos - current_package_info - module_system - in - match Lam_compile_env.get_package_path_from_cmj dep_module_id with - | (cmj_path, dep_package_info, little) -> - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name little in - let dep_info_query = - Js_packages_info.query_package_infos dep_package_info module_system - in - match dep_info_query, current_info_query with - | Package_not_found , _ -> - Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) - | Package_script , Package_found _ -> - Bs_exception.error (Dependency_script_module_dependent_not js_file) - | (Package_script | Package_found _ ), Package_not_found -> assert false - - | Package_found pkg, Package_script - -> - - pkg.pkg_rel_path // js_file - - - | Package_found dep_pkg, - Package_found cur_pkg -> - if Js_packages_info.same_package_by_name current_package_info dep_package_info then - Ext_path.node_rebase_file - ~from:cur_pkg.rel_path - ~to_:dep_pkg.rel_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - begin match module_system with - | NodeJS | Es6 -> + (* This may not be enough, + + + For cross packages, we may need settle down a single js package + We + may need es6 path for dead code elimination + + But frankly, very few JS packages have no dependency, so having plugin + may sound not that bad *) + | Runtime -> + get_runtime_module_path dep_module_id current_package_info module_system + | Ml -> ( + let query = Js_package_info.query_package_location_by_module_system in + let current_loc = query current_package_info module_system in + match Lam_compile_env.get_package_path_from_cmj dep_module_id with + | cmj_path, dep_package_info, case -> ( + let dep_loc = query dep_package_info module_system in + match (dep_loc, current_loc) with + | Package_not_found, _ -> + Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) + | Package_script, Package_found _ -> + let js_file = + Ext_namespace.js_filename_of_modulename + (* FIXME: Unsure how to infer a useful file-extension here. *) + ~name:dep_module_id.id.name ~ext:"" case + in + Bs_exception.error + (Dependency_script_module_dependent_not js_file) + | (Package_script | Package_found _), Package_not_found -> + assert false + | Package_found dep_pkg, Package_script -> + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in dep_pkg.pkg_rel_path // js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - - begin - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system - ) - ((Filename.dirname - (Filename.dirname (Filename.dirname cmj_path))) // dep_pkg.rel_path // js_file) - end - end - | Package_script, Package_script - -> - match Config_util.find_opt js_file with - | Some file -> - let basename = Filename.basename file in - let dirname = Filename.dirname file in - Ext_path.node_rebase_file - ~from:( - Ext_path.absolute_cwd_path - output_dir) - ~to_:( - Ext_path.absolute_cwd_path - - dirname) - basename - | None -> - Bs_exception.error (Js_not_found js_file)) + | Package_found dep_pkg, Package_found cur_pkg -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in + if + Js_package_info.same_package_by_name current_package_info + dep_package_info + then + Ext_path.node_rebase_file ~from:cur_pkg.rel_path + ~to_:dep_pkg.rel_path js_file + (* TODO: we assume that both [x] and [path] could only be + relative path which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + + dep_pkg.pkg_rel_path // js_file + + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package + path calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + ( Filename.dirname + (Filename.dirname (Filename.dirname cmj_path)) + // dep_pkg.rel_path // js_file ) ) + | Package_script, Package_script -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext case + in + match Config_util.find_opt js_file with + | Some file -> + let basename = Filename.basename file in + let dirname = Filename.dirname file in + Ext_path.node_rebase_file + ~from:(Ext_path.absolute_cwd_path output_dir) + ~to_:(Ext_path.absolute_cwd_path dirname) + basename + | None -> Bs_exception.error (Js_not_found js_file) ) ) ) ) - (* Override it in browser *) - -let string_of_module_id_in_browser (x : Lam_module_ident.t) = - match x.kind with - | External name -> name - | Runtime | Ml -> - "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" -let string_of_module_id - (id : Lam_module_ident.t) - ~output_dir:(_:string) - (_module_system : Js_packages_info.module_system) - = string_of_module_id_in_browser id + +let string_of_module_id_in_browser (x : Lam_module_ident.t) = + match x.kind with + | External name -> name + | Runtime | Ml -> + "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" + + +let string_of_module_id (id : Lam_module_ident.t) ~output_dir:(_ : string) + ~ext:(_ : string) (_module_system : Js_package_info.module_system) = + string_of_module_id_in_browser id end module Js_dump_program : sig #1 "js_dump_program.mli" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -110020,35 +109682,34 @@ module Js_dump_program : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** only used for debugging purpose *) val dump_program : J.program -> out_channel -> unit - +(** only used for debugging purpose *) val pp_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - Ext_pp.t -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + Ext_pp.t -> unit - val dump_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - out_channel -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + out_channel -> unit - + end = struct #1 "js_dump_program.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -110066,133 +109727,99 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) module P = Ext_pp -module L = Js_dump_lit +module L = Js_dump_lit +let empty_explanation = + "/* This output is empty. Its source's type definitions, externals and/or \ + unused code got optimized away. */\n" +let program_is_empty (x : J.program) = + match x with + | { block = []; exports = []; export_set = _ } -> true + | _ -> false -let empty_explanation = - "/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */\n" -let program_is_empty (x : J.program) = - match x with - | { - block = []; - exports = []; - export_set = _ - } -> true - | _ -> false +let deps_program_is_empty (x : J.deps_program) = + match x with + | { modules = []; program; side_effect = None } -> program_is_empty program + | _ -> false -let deps_program_is_empty (x : J.deps_program) = - match x with - | { modules = []; - program ; - side_effect = None - } -> program_is_empty program - | _ -> false -let program f cxt ( x : J.program ) = +let program f cxt (x : J.program) = P.force_newline f; - let cxt = Js_dump.statement_list true cxt f x.block in + let cxt = Js_dump.statement_list true cxt f x.block in P.force_newline f; Js_dump_import_export.exports cxt f x.exports -let dump_program (x : J.program) oc = - ignore (program (P.from_channel oc) Ext_pp_scope.empty x ) - -let node_program ~output_dir f ( x : J.deps_program) = - P.string f L.strict_directive; - P.newline f ; - let cxt = - Js_dump_import_export.requires - L.require - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id - x - ~output_dir - NodeJS - )) - in - program f cxt x.program +let dump_program (x : J.program) oc = + ignore (program (P.from_channel oc) Ext_pp_scope.empty x) +let node_program ~output_dir ~ext f (x : J.deps_program) = + P.string f L.strict_directive; + P.newline f; + let cxt = + Js_dump_import_export.requires L.require Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext NodeJS + ))) + in + program f cxt x.program -let es6_program ~output_dir fmt f ( x : J.deps_program) = - let cxt = - Js_dump_import_export.imports - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id x ~output_dir - fmt - )) - in - let () = P.force_newline f in - let cxt = Js_dump.statement_list true cxt f x.program.block in - let () = P.force_newline f in +let es6_program ~output_dir ~ext fmt f (x : J.deps_program) = + let cxt = + Js_dump_import_export.imports Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext fmt ))) + in + let () = P.force_newline f in + let cxt = Js_dump.statement_list true cxt f x.program.block in + let () = P.force_newline f in Js_dump_import_export.es6_export cxt f x.program.exports - (** Make sure github linguist happy + {[ require('Linguist') Linguist::FileBlob.new('jscomp/test/test_u.js').generated? - ]} -*) + ]} *) -let pp_deps_program - ~output_prefix - (kind : Js_packages_info.module_system ) - (program : J.deps_program) (f : Ext_pp.t) = - if not !Js_config.no_version_header then - begin - P.string f Bs_version.header; - P.newline f - end ; - if deps_program_is_empty program then - P.string f empty_explanation +let pp_deps_program ~output_prefix ~ext (kind : Js_package_info.module_system) + (program : J.deps_program) (f : Ext_pp.t) = + if not !Js_config.no_version_header then ( + P.string f Bs_version.header; + P.newline f ); + if deps_program_is_empty program then P.string f empty_explanation (* This is empty module, it won't be referred anywhere *) - else - let output_dir = Filename.dirname output_prefix in - begin - ignore (match kind with - | Es6 | Es6_global -> - es6_program ~output_dir kind f program - | NodeJS -> - node_program ~output_dir f program - ) ; - P.newline f ; - P.string f ( - match program.side_effect with - | None -> "/* No side effect */" - | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); - P.newline f; - P.flush f () - end - + else + let output_dir = Filename.dirname output_prefix in + ignore + ( match kind with + | Es6 | Es6_global -> es6_program ~output_dir ~ext kind f program + | NodeJS -> node_program ~output_dir ~ext f program ); + P.newline f; + P.string f + ( match program.side_effect with + | None -> "/* No side effect */" + | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); + P.newline f; + P.flush f () -let dump_deps_program - ~output_prefix - kind - x - (oc : out_channel) = - pp_deps_program ~output_prefix kind x (P.from_channel oc) +let dump_deps_program ~output_prefix ~ext kind x (oc : out_channel) = + pp_deps_program ~output_prefix ~ext kind x (P.from_channel oc) end module Jsoo_common : sig @@ -128723,7 +128350,7 @@ end module Lam_stats_export : sig #1 "lam_stats_export.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128741,32 +128368,25 @@ module Lam_stats_export : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val get_dependent_module_effect : + Lam_stats.t -> string option -> Lam_module_ident.t list -> string option - - -val get_dependent_module_effect: - Lam_stats.t -> - string option -> - Lam_module_ident.t list -> - string option - -val export_to_cmj : +val export_to_cmj : Lam_stats.t -> Js_cmj_format.effect -> Lam.t Map_ident.t -> - Js_cmj_format.cmj_case -> + Ext_namespace.leading_case -> Js_cmj_format.t - end = struct #1 "lam_stats_export.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128784,141 +128404,109 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let pp = Format.fprintf - - - - -let pp = Format.fprintf (* we should exclude meaninglist names and do the convert as well *) - -(* let meaningless_names = ["*opt*"; "param";] *) - - +(* let meaningless_names = ["*opt*"; "param";] *) let single_na = Js_cmj_format.single_na -let values_of_export - (meta : Lam_stats.t) - (export_map : Lam.t Map_ident.t) - : Js_cmj_format.cmj_value Map_string.t - = - Ext_list.fold_left meta.exports Map_string.empty - (fun acc x -> - let arity : Js_cmj_format.arity = - match Hash_ident.find_opt meta.ident_tbl x with - | Some (FunctionId {arity ; _}) -> Single arity - | Some (ImmutableBlock(elems)) -> - (* FIXME: field name for dumping*) - Submodule(Ext_array.map elems (fun x -> - match x with - | NA -> Lam_arity.na - | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam) - ) - | Some _ - | None -> - begin match Map_ident.find_opt export_map x with - | Some (Lprim {primitive = Pmakeblock (_,_, Immutable); args }) -> - Submodule (Ext_array.of_list_map args (fun lam -> - Lam_arity_analysis.get_arity meta lam)) - | Some _ - | None -> single_na - end - in - let persistent_closed_lambda = - if not !Js_config.cross_module_inline then None - else match Map_ident.find_opt export_map x with - | Some lambda -> - if Lam_analysis.safe_to_inline lambda - (* when inlning a non function, we have to be very careful, - only truly immutable values can be inlined - *) - then - if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *) - then - if Lam_closure.is_closed lambda (* TODO: seriealize more*) - then Some lambda - else None - else - let lam_size = Lam_analysis.size lambda in - (* TODO: - 1. global need re-assocate when do the beta reduction - 2. [lambda_exports] is not precise - *) - let free_variables = - Lam_closure.free_variables Set_ident.empty Map_ident.empty lambda in - if lam_size < Lam_analysis.small_inline_size && - Map_ident.is_empty free_variables - then - begin - Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name ; - Some lambda - end - else None - else - None - | None -> None in - Map_string.add acc x.name Js_cmj_format.{arity ; persistent_closed_lambda } - ) +let values_of_export (meta : Lam_stats.t) (export_map : Lam.t Map_ident.t) : + Js_cmj_format.cmj_value Map_string.t = + Ext_list.fold_left meta.exports Map_string.empty (fun acc x -> + let arity : Js_cmj_format.arity = + match Hash_ident.find_opt meta.ident_tbl x with + | Some (FunctionId { arity; _ }) -> Single arity + | Some (ImmutableBlock elems) -> + (* FIXME: field name for dumping*) + Submodule + (Ext_array.map elems (fun x -> + match x with + | NA -> Lam_arity.na + | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> ( + match Map_ident.find_opt export_map x with + | Some (Lprim { primitive = Pmakeblock (_, _, Immutable); args }) -> + Submodule + (Ext_array.of_list_map args (fun lam -> + Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> single_na ) + in + let persistent_closed_lambda = + if not !Js_config.cross_module_inline then None + else + match Map_ident.find_opt export_map x with + | Some lambda -> + if + Lam_analysis.safe_to_inline lambda + (* when inlning a non function, we have to be very careful, only + truly immutable values can be inlined *) + then + if + Lam_inline_util.should_be_functor x.name lambda + (* can also be submodule *) + then + if Lam_closure.is_closed lambda (* TODO: seriealize more*) + then Some lambda + else None + else + let lam_size = Lam_analysis.size lambda in + (* TODO: 1. global need re-assocate when do the beta reduction + 2. [lambda_exports] is not precise *) + let free_variables = + Lam_closure.free_variables Set_ident.empty Map_ident.empty + lambda + in + if + lam_size < Lam_analysis.small_inline_size + && Map_ident.is_empty free_variables + then ( + Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name; + Some lambda ) + else None + else None + | None -> None + in + Map_string.add acc x.name + Js_cmj_format.{ arity; persistent_closed_lambda }) -(* ATTENTION: all runtime modules, if it is not hard required, - it should be okay to not reference it -*) -let get_dependent_module_effect - (meta : Lam_stats.t) - (maybe_pure : string option) - (external_ids : Lam_module_ident.t list) = + +(* ATTENTION: all runtime modules, if it is not hard required, it should be okay + to not reference it *) +let get_dependent_module_effect (meta : Lam_stats.t) + (maybe_pure : string option) (external_ids : Lam_module_ident.t list) = if maybe_pure = None then - let non_pure_module = - Ext_list.find_first_not external_ids - Lam_compile_env.is_pure_module - in - Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) - else - maybe_pure + let non_pure_module = + Ext_list.find_first_not external_ids Lam_compile_env.is_pure_module + in + Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) + else maybe_pure +(* Note that [lambda_exports] is lambda expression to be exported for the js + backend, we compile to js for the inliner, we try to seriaize it -- relies on + other optimizations to make this happen {[ exports.Make = function () {.....} + ]} TODO: check that we don't do this in browser environment *) +let export_to_cmj (meta : Lam_stats.t) effect export_map + (leading_case : Ext_namespace.leading_case) : Js_cmj_format.t = + let values = values_of_export meta export_map in -(* Note that - [lambda_exports] is - lambda expression to be exported - for the js backend, we compile to js - for the inliner, we try to seriaize it -- - relies on other optimizations to make this happen - {[ - exports.Make = function () {.....} - ]} - TODO: check that we don't do this in browser environment -*) -let export_to_cmj - (meta : Lam_stats.t ) - effect - export_map - cmj_case - : Js_cmj_format.t = - let values = values_of_export meta export_map in - - Js_cmj_format.mk - ~values - ~effect - ~npm_package_path: (Js_packages_state.get_packages_info ()) - ~cmj_case - (* FIXME: make sure [-o] would not change its case - add test for ns/non-ns - *) - - + (* FIXME: make sure [-o] would not change its case *) + (* FIXME: add test for ns/non-ns *) + Js_cmj_format.mk ~values ~effect + ~package_info:(Js_current_package_info.get_packages_info ()) + ~leading_case end module Lam_compile_main : sig #1 "lam_compile_main.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128936,40 +128524,25 @@ module Lam_compile_main : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** BuckleScript entry point in the OCaml compiler *) +val compile : string -> Lambda.lambda -> J.deps_program +(** Compile and register the hook of function to compile a lambda to JS IR + For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name + ()} *) - - - - -(** BuckleScript entry point in the OCaml compiler *) - -(** Compile and register the hook of function to compile a lambda to JS IR - *) - -(** For toplevel, [filename] is [""] which is the same as - {!Env.get_unit_name ()} - *) -val compile : - string -> - Lambda.lambda -> - J.deps_program - -val lambda_as_module : - J.deps_program -> - string -> - unit +val lambda_as_module : J.deps_program -> string -> unit end = struct #1 "lam_compile_main.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128987,290 +128560,240 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +module E = Js_exp_make +module S = Js_stmt_make +let get_leading_case output_prefix : Ext_namespace.leading_case = + if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Lower + else Upper +let compile_group (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = + match x with + (* We need: 1. [E.builtin_dot] for javascript builtin, 2. [E.mldot] *) + (* ATTENTION: check {!Lam_compile_global} for consistency *) + (* Special handling for values in [Pervasives] *) + (* we delegate [stdout, stderr, and stdin] into [caml_io] module, the + motivation is to help dead code eliminatiion, it's helpful to make those + parts pure (not a function call), then it can be removed if unused *) + + (* QUICK hack to make hello world example nicer, Note the arity of + [print_endline] is already analyzed before, so it should be safe *) + | Single (kind, id, lam) -> + (* let lam = Optimizer.simplify_lets [] lam in *) + (* can not apply again, it's wrong USE it with care *) + (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) + Lam_compile.compile_lambda + { + continuation = Declare (kind, id); + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam + | Recursive id_lams -> + Lam_compile.compile_recursive_lets + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + id_lams + | Nop lam -> + (* TODO: Side effect callls, log and see statistics *) + Lam_compile.compile_lambda + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam +(* Also need analyze its depenency is pure or not *) +let no_side_effects (rest : Lam_group.t list) : string option = + Ext_list.find_opt rest (fun x -> + match x with + | Single (kind, id, body) -> ( + match kind with + | Strict | Variable -> + if not @@ Lam_analysis.no_side_effects body then + Some (Printf.sprintf "%s" id.name) + else None + | _ -> None ) + | Recursive bindings -> + Ext_list.find_opt bindings (fun (id, lam) -> + if not @@ Lam_analysis.no_side_effects lam then + Some (Printf.sprintf "%s" id.Ident.name) + else None) + | Nop lam -> + if not @@ Lam_analysis.no_side_effects lam then + (* (Lam_util.string_of_lambda lam) *) + Some "" + else None + (* TODO :*)) -module E = Js_exp_make -module S = Js_stmt_make - -let get_cmj_case output_prefix : Ext_namespace.file_kind = - let little = - Ext_char.is_lower_case (Filename.basename output_prefix).[0] - in - match little, !Js_config.bs_suffix with - | true, true -> Little_bs - | true, false -> Little_js - | false, true -> Upper_bs - | false, false -> Upper_js - - -let compile_group (meta : Lam_stats.t) - (x : Lam_group.t) : Js_output.t = - match x with - (* - We need - - 2. [E.builtin_dot] for javascript builtin - 3. [E.mldot] - *) - (* ATTENTION: check {!Lam_compile_global} for consistency *) - (** Special handling for values in [Pervasives] *) - (* - we delegate [stdout, stderr, and stdin] into [caml_io] module, - the motivation is to help dead code eliminatiion, it's helpful - to make those parts pure (not a function call), then it can be removed - if unused - *) - - (* QUICK hack to make hello world example nicer, - Note the arity of [print_endline] is already analyzed before, - so it should be safe - *) - - | Single (kind, id, lam) -> - (* let lam = Optimizer.simplify_lets [] lam in *) - (* can not apply again, it's wrong USE it with care*) - (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda { continuation = Declare (kind, id); - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - - | Recursive id_lams -> - Lam_compile.compile_recursive_lets - { continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } - id_lams - | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda {continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - -;; - - (** Also need analyze its depenency is pure or not *) -let no_side_effects (rest : Lam_group.t list) : string option = - Ext_list.find_opt rest (fun x -> - match x with - | Single(kind,id,body) -> - begin - match kind with - | Strict | Variable -> - if not @@ Lam_analysis.no_side_effects body - then Some (Printf.sprintf "%s" id.name) - else None - | _ -> None - end - | Recursive bindings -> - Ext_list.find_opt bindings (fun (id,lam) -> - if not @@ Lam_analysis.no_side_effects lam - then Some (Printf.sprintf "%s" id.Ident.name ) - else None - ) - | Nop lam -> - if not @@ Lam_analysis.no_side_effects lam - then - (* (Lam_util.string_of_lambda lam) *) - Some "" - else None (* TODO :*)) - +let _d s lam = -let _d = fun s lam -> + lam - lam -let _j = Js_pass_debug.dump +let _j = Js_pass_debug.dump -(** Actually simplify_lets is kind of global optimization since it requires you to know whether - it's used or not -*) -let compile - (output_prefix : string) - (lam : Lambda.lambda) = - let export_idents = Translmod.get_export_identifiers() in - let export_ident_sets = Set_ident.of_list export_idents in +(* Actually simplify_lets is kind of global optimization since it requires you + to know whether it's used or not *) +let compile (output_prefix : string) (lam : Lambda.lambda) = + let export_idents = Translmod.get_export_identifiers () in + let export_ident_sets = Set_ident.of_list export_idents in (* To make toplevel happy - reentrant for js-demo *) - let () = - - Lam_compile_env.reset () ; - in - let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + let () = - - let lam = _d "initial" lam in - let lam = Lam_pass_deep_flatten.deep_flatten lam in - let lam = _d "flatten0" lam in - let meta : Lam_stats.t = - Lam_stats.make - ~export_idents - ~export_ident_sets in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - let lam = - lam - |> _d "flattern1" - |> Lam_pass_exits.simplify_exits + Lam_compile_env.reset () + in + let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + + let lam = _d "initial" lam in + let lam = Lam_pass_deep_flatten.deep_flatten lam in + let lam = _d "flatten0" lam in + let meta : Lam_stats.t = Lam_stats.make ~export_idents ~export_ident_sets in + let () = Lam_pass_collect.collect_info meta lam in + let lam = + let lam = + lam |> _d "flattern1" |> Lam_pass_exits.simplify_exits |> _d "simplyf_exits" - |> (fun lam -> Lam_pass_collect.collect_info meta lam; lam) - |> Lam_pass_remove_alias.simplify_alias meta - |> _d "simplify_alias" - |> Lam_pass_deep_flatten.deep_flatten - |> _d "flatten2" - in (* Inling happens*) - - let () = Lam_pass_collect.collect_info meta lam in - let lam = Lam_pass_remove_alias.simplify_alias meta lam in + |> (fun lam -> + Lam_pass_collect.collect_info meta lam; + lam) + |> Lam_pass_remove_alias.simplify_alias meta + |> _d "simplify_alias" |> Lam_pass_deep_flatten.deep_flatten + |> _d "flatten2" + in + + (* Inling happens*) + let () = Lam_pass_collect.collect_info meta lam in + let lam = Lam_pass_remove_alias.simplify_alias meta lam in let lam = Lam_pass_deep_flatten.deep_flatten lam in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - lam - |> _d "alpha_before" + let () = Lam_pass_collect.collect_info meta lam in + let lam = + lam |> _d "alpha_before" |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "alpha_after" - |> Lam_pass_exits.simplify_exits in + |> _d "alpha_after" |> Lam_pass_exits.simplify_exits + in let () = Lam_pass_collect.collect_info meta lam in - - lam - |> _d "simplify_alias_before" - |> Lam_pass_remove_alias.simplify_alias meta + lam |> _d "simplify_alias_before" + |> Lam_pass_remove_alias.simplify_alias meta |> _d "alpha_conversion" - |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "before-simplify_lets" + |> Lam_pass_alpha_conversion.alpha_conversion meta + |> _d "before-simplify_lets" (* we should investigate a better way to put different passes : )*) - |> Lam_pass_lets_dce.simplify_lets - + |> Lam_pass_lets_dce.simplify_lets |> _d "before-simplify-exits" - (* |> (fun lam -> Lam_pass_collect.collect_info meta lam - ; Lam_pass_remove_alias.simplify_alias meta lam) *) - (* |> Lam_group_pass.scc_pass - |> _d "scc" *) + (* |> (fun lam -> Lam_pass_collect.collect_info meta lam ; + Lam_pass_remove_alias.simplify_alias meta lam) *) + (* |> Lam_group_pass.scc_pass |> _d "scc" *) |> Lam_pass_exits.simplify_exits |> _d "simplify_lets" - + + in + + let ({ Lam_coercion.groups } as coerced_input), meta = + Lam_coercion.coerce_and_group_big_lambda meta lam in - let ({Lam_coercion.groups = groups } as coerced_input , meta) = - Lam_coercion.coerce_and_group_big_lambda meta lam - in - let maybe_pure = no_side_effects groups in - - let body = + + let body = Ext_list.map groups (fun group -> compile_group meta group) - |> Js_output.concat - |> Js_output.output_as_block + |> Js_output.concat |> Js_output.output_as_block in - + (* The file is not big at all compared with [cmo] *) - (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) - let meta_exports = meta.exports in - let export_set = Set_ident.of_list meta_exports in - let js : J.program = - { - exports = meta_exports ; - export_set; - block = body} - in - js - |> _j "initial" - |> Js_pass_flatten.program - |> _j "flattern" - |> Js_pass_tailcall_inline.tailcall_inline - |> _j "inline_and_shake" - |> Js_pass_flatten_and_mark_dead.program - |> _j "flatten_and_mark_dead" + (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) + let meta_exports = meta.exports in + let export_set = Set_ident.of_list meta_exports in + let js : J.program = { exports = meta_exports; export_set; block = body } in + js |> _j "initial" |> Js_pass_flatten.program |> _j "flattern" + |> Js_pass_tailcall_inline.tailcall_inline |> _j "inline_and_shake" + |> Js_pass_flatten_and_mark_dead.program |> _j "flatten_and_mark_dead" (* |> Js_inline_and_eliminate.inline_and_shake *) (* |> _j "inline_and_shake" *) - |> (fun js -> ignore @@ Js_pass_scope.program js ; js ) - |> Js_shake.shake_program - |> _j "shake" - |> ( fun (program: J.program) -> - let external_module_ids : Lam_module_ident.t list = - if !Js_config.all_module_aliases then [] - else - let x = Lam_compile_env.get_required_modules - may_required_modules - (Js_fold_basic.calculate_hard_dependencies program.block) in - if !Js_config.sort_imports then - Ext_list.sort_via_array x - (fun id1 id2 -> - Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2) - ) - else - x - in - Warnings.check_fatal (); - let effect = - Lam_stats_export.get_dependent_module_effect - meta maybe_pure external_module_ids in - let v : Js_cmj_format.t = - Lam_stats_export.export_to_cmj - meta - effect - coerced_input.export_map - (get_cmj_case output_prefix) + |> (fun js -> + ignore @@ Js_pass_scope.program js; + js) + |> Js_shake.shake_program |> _j "shake" + |> fun (program : J.program) -> + let external_module_ids : Lam_module_ident.t list = + if !Js_config.all_module_aliases then [] + else + let x = + Lam_compile_env.get_required_modules may_required_modules + (Js_fold_basic.calculate_hard_dependencies program.block) in - (if not @@ !Clflags.dont_write_files then - Js_cmj_format.to_file - ~check_exists:(not !Js_config.force_cmj) - (output_prefix ^ Literals.suffix_cmj) v); - {J.program = program ; side_effect = effect ; modules = external_module_ids } - ) -;; - -let (//) = Filename.concat - -let lambda_as_module - (lambda_output : J.deps_program) - (output_prefix : string) - : unit = - let basename = - Ext_namespace.change_ext_ns_suffix - (Filename.basename - output_prefix) - (if !Js_config.bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) - in - let package_info = Js_packages_state.get_packages_info () in - if Js_packages_info.is_empty package_info && !Js_config.js_stdout then - Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout + if !Js_config.sort_imports then + Ext_list.sort_via_array x (fun id1 id2 -> + Ext_string.compare + (Lam_module_ident.name id1) + (Lam_module_ident.name id2)) + else x + in + Warnings.check_fatal (); + let effect = + Lam_stats_export.get_dependent_module_effect meta maybe_pure + external_module_ids + in + let v : Js_cmj_format.t = + Lam_stats_export.export_to_cmj meta effect coerced_input.export_map + (get_leading_case output_prefix) + in + if not @@ !Clflags.dont_write_files then + Js_cmj_format.to_file ~check_exists:(not !Js_config.force_cmj) + (output_prefix ^ Literals.suffix_cmj) + v; + { J.program; side_effect = effect; modules = external_module_ids } + + +let ( // ) = Filename.concat + +let lambda_as_module (lambda_output : J.deps_program) (output_prefix : string) : + unit = + let package_info = Js_current_package_info.get_packages_info () in + if Js_package_info.is_empty package_info && !Js_config.js_stdout then + Js_dump_program.dump_deps_program ~ext:".js" ~output_prefix NodeJS + lambda_output stdout else - Js_packages_info.iter package_info (fun {module_system; path = _path} -> - let output_chan chan = - Js_dump_program.dump_deps_program ~output_prefix - module_system - lambda_output - chan in - if not @@ !Clflags.dont_write_files then + Js_package_info.iter package_info + (fun { module_system; path = _path; extension } -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:(Filename.basename output_prefix) + ~ext:extension + in + let output_chan chan = + Js_dump_program.dump_deps_program ~output_prefix ~ext:extension + module_system lambda_output chan + in + if not @@ !Clflags.dont_write_files then Ext_pervasives.with_file_as_chan - (Lazy.force Ext_path.package_dir // - _path // - basename - (* #913 only generate little-case js file *) - ) output_chan ) - + ( Lazy.force Ext_path.package_dir + // _path // basename (* #913 only generate little-case js file *) ) + output_chan) -(* 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, - includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr} +(* 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, includes {!Pervasives.stdin, Pervasives.stdout, + Pervasives.stderr} - However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name -*) + However, use filename instead of {!Env.current_unit} is more honest, since + node-js module system is coupled with the file name *) end module Parse : sig @@ -132733,165 +132256,167 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** *) module Js = Jsoo_common.Js -(* - Error: - * { - * row: 12, - * column: 2, //can be undefined - * text: "Missing argument", - * type: "error" // or "warning" or "info" - * } -*) -let () = +(** Error: + + {v + { + row: 12, + column: 2, //can be undefined + text: "Missing argument", + type: "error" // or "warning" or "info" + } + v} *) +let () = Bs_conditional_initial.setup_env (); Clflags.binary_annotations := false -let error_of_exn e = - match Location.error_of_exn e with - | Some (`Ok e) -> Some e - | Some `Already_displayed - | None -> None + +let error_of_exn e = + match Location.error_of_exn e with + | Some (`Ok e) -> Some e + | Some `Already_displayed | None -> None + type react_ppx_version = V2 | V3 -let implementation ~use_super_errors ?(react_ppx_version=V3) prefix impl str : Js.Unsafe.obj = +let implementation ~use_super_errors ?(react_ppx_version = V3) prefix impl str : + Js.Unsafe.obj = let modulename = "Test" in (* let env = !Toploop.toplevel_env in *) (* Compmisc.init_path false; *) (* let modulename = module_of_filename ppf sourcefile outputprefix in *) (* Env.set_unit_name modulename; *) - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in (* Question ?? *) + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + (* Question ?? *) (* let finalenv = ref Env.empty in *) let types_signature = ref [] in - if use_super_errors then begin + if use_super_errors then ( Misc.Color.setup (Some Always); - Lazy.force Super_main.setup ; - end; - + Lazy.force Super_main.setup ); try - let ast = impl - (Lexing.from_string - (if prefix then "[@@@bs.config{no_export}]\n#1 \"repl.ml\"\n" ^ str else str )) in - let ast = match react_ppx_version with - | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast - | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast in - let ast = Bs_builtin_ppx.rewrite_implementation ast in - let typed_tree = - let (a,b,_,signature) = Typemod.type_implementation_more modulename modulename modulename env ast in + let ast = + impl + (Lexing.from_string + ( if prefix then "[@@@bs.config{no_export}]\n#1 \"repl.ml\"\n" ^ str + else str )) + in + let ast = + match react_ppx_version with + | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast + | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast + in + let ast = Bs_builtin_ppx.rewrite_implementation ast in + let typed_tree = + let a, b, _, signature = + Typemod.type_implementation_more modulename modulename modulename env + ast + in (* finalenv := c ; *) types_signature := signature; - (a,b) in - typed_tree - |> Translmod.transl_implementation modulename - |> (* Printlambda.lambda ppf *) (fun - {Lambda.code = lam} - -> - let buffer = Buffer.create 1000 in - let () = Js_dump_program.pp_deps_program - ~output_prefix:"" (* does not matter here *) - NodeJS - (Lam_compile_main.compile "" - lam) - (Ext_pp.from_buffer buffer) in - let v = Buffer.contents buffer in - Js.Unsafe.(obj [| "js_code", inject @@ Js.string v |]) ) - (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) - with - | e -> - begin match error_of_exn e with - | Some error -> - Location.report_error Format.err_formatter error; - Jsoo_common.mk_js_error error.loc error.msg - | None -> - Js.Unsafe.(obj [| - "js_error_msg" , inject @@ Js.string (Printexc.to_string e) - |]) - - end + (a, b) + in + typed_tree |> Translmod.transl_implementation modulename + |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam } -> + let buffer = Buffer.create 1000 in + let () = + Js_dump_program.pp_deps_program (* does not matter here *) + ~output_prefix:"" ~ext:".js" NodeJS + (Lam_compile_main.compile "" lam) + (Ext_pp.from_buffer buffer) + in + let v = Buffer.contents buffer in + Js.Unsafe.(obj [| ("js_code", inject @@ Js.string v) |]) + (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) + with e -> ( + match error_of_exn e with + | Some error -> + Location.report_error Format.err_formatter error; + Jsoo_common.mk_js_error error.loc error.msg + | None -> + let open Js.Unsafe in + obj [| ("js_error_msg", inject @@ Js.string (Printexc.to_string e)) |] ) let compile impl ~use_super_errors ?react_ppx_version = - implementation ~use_super_errors ?react_ppx_version false impl + implementation ~use_super_errors ?react_ppx_version false impl + (** TODO: add `[@@bs.config{no_export}]\n# 1 "repl.ml"`*) let shake_compile impl ~use_super_errors ?react_ppx_version = - implementation ~use_super_errors ?react_ppx_version true impl - + implementation ~use_super_errors ?react_ppx_version true impl let load_module cmi_path cmi_content cmj_name cmj_content = Js.create_file cmi_path cmi_content; Js_cmj_datasets.data_sets := - Map_string.add !Js_cmj_datasets.data_sets - cmj_name (lazy (Js_cmj_format.from_string cmj_content)) - + Map_string.add !Js_cmj_datasets.data_sets cmj_name + (lazy (Js_cmj_format.from_string cmj_content)) -let export (field : string) v = - Js.Unsafe.set (Js.Unsafe.global) field v -;; +let export (field : string) v = Js.Unsafe.set Js.Unsafe.global field v (* To add a directory to the load path *) -let dir_directory d = - Config.load_path := d :: !Config.load_path - +let dir_directory d = Config.load_path := d :: !Config.load_path -let () = - dir_directory "/static/cmis" +let () = dir_directory "/static/cmis" let make_compiler name impl = export name - (Js.Unsafe.(obj - [|"compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:false (Js.to_string code))); - "shake_compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (shake_compile impl ~use_super_errors:false (Js.to_string code))); - "compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true (Js.to_string code))); - "compile_super_errors_ppx_v2", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V2 (Js.to_string code))); - "compile_super_errors_ppx_v3", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V3 (Js.to_string code))); - "shake_compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> (shake_compile impl ~use_super_errors:true (Js.to_string code))); - "version", Js.Unsafe.inject (Js.string (Bs_version.version)); - "load_module", - inject @@ - Js.wrap_meth_callback - (fun _ cmi_path cmi_content cmj_name cmj_content -> - let cmj_bytestring = Js.to_bytestring cmj_content in - (* HACK: force string tag to ASCII (9) to avoid - * UTF-8 encoding *) - Js.Unsafe.set cmj_bytestring "t" 9; - load_module cmi_path cmi_content (Js.to_string cmj_name) cmj_bytestring); - |])) + Js.Unsafe.( + obj + [| + ( "compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:false (Js.to_string code)) ); + ( "shake_compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:false + (Js.to_string code)) ); + ( "compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true (Js.to_string code)) ); + ( "compile_super_errors_ppx_v2", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V2 + (Js.to_string code)) ); + ( "compile_super_errors_ppx_v3", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V3 + (Js.to_string code)) ); + ( "shake_compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:true (Js.to_string code)) + ); + ("version", Js.Unsafe.inject (Js.string Bs_version.version)); + ( "load_module", + inject + @@ Js.wrap_meth_callback + (fun _ cmi_path cmi_content cmj_name cmj_content -> + let cmj_bytestring = Js.to_bytestring cmj_content in + (* HACK: force string tag to ASCII (9) to avoid + * UTF-8 encoding *) + Js.Unsafe.set cmj_bytestring "t" 9; + load_module cmi_path cmi_content (Js.to_string cmj_name) + cmj_bytestring) ); + |]) + + let () = make_compiler "ocaml" Parse.implementation (* local variables: *) -(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *) +(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene + driver.cmo" *) (* end: *) end diff --git a/lib/4.06.1/unstable/js_compiler.ml.d b/lib/4.06.1/unstable/js_compiler.ml.d index 823a5525ff..00ac81fae7 100644 --- a/lib/4.06.1/unstable/js_compiler.ml.d +++ b/lib/4.06.1/unstable/js_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/unstable/js_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_datasets.ml ./core/js_cmj_datasets.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_main.ml ./main/jsoo_main.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file +../lib/4.06.1/unstable/js_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_datasets.ml ./core/js_cmj_datasets.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_current_package_info.ml ./core/js_current_package_info.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_package_info.ml ./core/js_package_info.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_main.ml ./main/jsoo_main.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 96ee08058a..acae7cf6f8 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -14128,7 +14128,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14146,96 +14146,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -14263,83 +14241,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -14359,7 +14301,7 @@ end module Bs_warnings : sig #1 "bs_warnings.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14377,29 +14319,27 @@ module Bs_warnings : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit end = struct #1 "bs_warnings.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14417,117 +14357,106 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) - - + Format.pp_print_flush warning_formatter () ) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) -(** - Note the standard way of reporting error in compiler: +(** Note the standard way of reporting error in compiler: - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error - Define an error type + Define an error type - type error - exception Error of Location.t * error + type error exception Error of Location.t * error - Provide a printer to error + Provide a printer to error - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) end module Ext_util : sig @@ -15131,7 +15060,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15149,7 +15078,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15159,7 +15088,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -15172,9 +15101,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -15217,7 +15146,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -15227,48 +15156,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15286,7 +15220,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15300,7 +15234,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -15359,8 +15293,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -15368,19 +15302,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -15399,9 +15338,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ast_attributes : sig #1 "ast_attributes.mli" @@ -75508,7 +75448,7 @@ end module Ext_namespace : sig #1 "ext_namespace.mli" (* Copyright (C) 2017- Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -75526,64 +75466,38 @@ module Ext_namespace : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option - -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. *) -val change_ext_ns_suffix : - string -> - string -> - string -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string +type leading_case = Upper | Lower -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) + +val is_valid_npm_package_name : string -> bool val namespace_of_package_name : string -> string end = struct #1 "ext_namespace.ml" - (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -75601,115 +75515,116 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) let ns_sep_char = '-' let ns_sep = "-" -let make ?ns cunit = - match ns with +let make ?ns cunit = + match ns with | None -> cunit | Some ns -> cunit ^ ns_sep ^ ns -let rec rindex_rec s i = - if i < 0 then i else +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 + #1933 when removing ns suffix, don't pass the bound of basename - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) + + +type leading_case = Upper | Lower + +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext + + +(** https://docs.npmjs.com/files/package.json + + Some rules: + + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. + + TODO: handle cases like '\@angular/core'. its directory structure is like: + + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false + + +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = if off >= len then () - else + else let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf end module Outcome_printer_ns : sig @@ -90455,8 +90370,8 @@ end = struct #1 "ext_arg.ml" let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt end -module Js_packages_info : sig -#1 "js_packages_info.mli" +module Js_package_info : sig +#1 "js_package_info.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -90481,91 +90396,56 @@ module Js_packages_info : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type module_system = NodeJS | Es6 | Es6_global -type module_system = - | NodeJS - | Es6 - | Es6_global +val runtime_dir_of_module_system : module_system -> string - -val runtime_dir_of_module_system : - module_system -> - string +val runtime_package_path : module_system -> string -> string -val runtime_package_path: - module_system -> - string -> - string - -type package_info - = - { - module_system : module_system ; - path : string - } - -type t - -val is_runtime_package: - t -> - bool - -val same_package_by_name : - t -> - t -> - bool +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} -val iter : - t -> - (package_info -> unit) -> - unit +type t -val empty : t -val from_name : string -> t -val is_empty : t -> bool +val is_runtime_package : t -> bool -val dump_packages_info : - Format.formatter -> t -> unit +val same_package_by_name : t -> t -> bool +val iter : t -> (location_descriptor -> unit) -> unit -(** used by command line option - e.g [-bs-package-output commonjs:xx/path] -*) -val add_npm_package_path : - t -> - string -> - t +val empty : t +val from_name : string -> t +val is_empty : t -> bool -type package_found_info = - { +val dump_package_info : Format.formatter -> t -> unit - rel_path : string ; - pkg_rel_path : string - } +val deprecated_set_bs_extension : unit -> unit -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info +val append_location_descriptor_of_string : t -> string -> t +(** used by command line option e.g [-bs-package-output commonjs:xx/path:ext] *) -val get_output_dir: - t -> - package_dir:string -> - module_system -> - string +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} -val query_package_infos: - t -> - module_system -> - info_query -(** Note here we compare the package info by order - in theory, we can compare it by set semantics -*) +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths +val get_output_dir : t -> package_dir:string -> module_system -> string +(* Note here we compare the package info by order in theory, we can compare it + by set semantics *) +val query_package_location_by_module_system : t -> module_system -> query_result end = struct -#1 "js_packages_info.ml" +#1 "js_package_info.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -90595,239 +90475,201 @@ end = struct type path = string type module_system = - | NodeJS + | NodeJS | Es6 - | Es6_global (* ignore node_modules, just calcluating relative path *) - - -(* ocamlopt could not optimize such simple case..*) -let compatible (dep : module_system) - (query : module_system) = - match query with - | NodeJS -> dep = NodeJS - | Es6 -> dep = Es6 - | Es6_global - -> dep = Es6_global || dep = Es6 -(* As a dependency Leaf Node, it is the same either [global] or [not] *) - - -type package_info = - { module_system : module_system ; path : string } - -type package_name = - | Pkg_empty - | Pkg_runtime - | Pkg_normal of string + (* ignore node_modules, just calcluating relative path *) + | Es6_global + +(* ocamlopt could not optimize such simple case... *) +let compatible (dep : module_system) (query : module_system) = + match query with + | NodeJS -> dep = NodeJS + | Es6 -> dep = Es6 + (* As a dependency Leaf Node, it is the same either [global] or [not] *) + | Es6_global -> dep = Es6_global || dep = Es6 + + +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} +type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string +let deprecated_use_bs_extension = ref false let runtime_package_name = "bs-platform" +let ( // ) = Filename.concat -let (//) = Filename.concat - -(* in runtime lib, [es6] and [es6] are treated the same wway *) -let runtime_dir_of_module_system (ms : module_system ) = - match ms with +(* in runtime lib, [es6] and [es6-global] are treated the same way *) +let runtime_dir_of_module_system (ms : module_system) = + match ms with | NodeJS -> "js" | Es6 | Es6_global -> "es6" -let runtime_package_path - (ms : module_system) - js_file = - runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file - -type t = - { - name : package_name ; - module_systems: package_info list - } +let runtime_package_path (ms : module_system) js_file = + runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file -let same_package_by_name (x : t) (y : t) = x.name = y.name -let is_runtime_package (x : t) = - x.name = Pkg_runtime +type t = { name : package_name; locations : location_descriptor list } -let iter (x : t) cb = - Ext_list.iter x.module_systems cb +let same_package_by_name (x : t) (y : t) = x.name = y.name -(* let equal (x : t) ({name; module_systems}) = - x.name = name && - Ext_list.for_all2_no_exn - x.module_systems module_systems - (fun (a0,a1) (b0,b1) -> a0 = b0 && a1 = b1) *) +let is_runtime_package (x : t) = x.name = Pkg_runtime -(* we don't want force people to use package *) +let iter (x : t) = Ext_list.iter x.locations -(** - TODO: not allowing user to provide such specific package name - For empty package, [-bs-package-output] does not make sense - it is only allowed to generate commonjs file in the same directory -*) -let empty : t = - { name = Pkg_empty ; - module_systems = [] - } +(* TODO: not allowing user to provide such specific package name For empty + package, [-bs-package-output] does not make sense it is only allowed to + generate commonjs file in the same directory *) +let empty : t = { name = Pkg_empty; locations = [] } let from_name (name : string) = - if name = runtime_package_name then - { - name = Pkg_runtime ; module_systems = [] - } - else - { - name = Pkg_normal name ; - module_systems = [] - } + if name = runtime_package_name then { name = Pkg_runtime; locations = [] } + else { name = Pkg_normal name; locations = [] } -let is_empty (x : t) = - x.name = Pkg_empty - -let string_of_module_system (ms : module_system) = - match ms with +let is_empty (x : t) = x.name = Pkg_empty + +let string_of_module_system (ms : module_system) = + match ms with | NodeJS -> "NodeJS" | Es6 -> "Es6" | Es6_global -> "Es6_global" - -let module_system_of_string package_name : module_system option = + +let module_system_of_string package_name : module_system option = match package_name with | "commonjs" -> Some NodeJS | "es6" -> Some Es6 | "es6-global" -> Some Es6_global - | _ -> None + | _ -> None -let dump_package_info - (fmt : Format.formatter) - ({module_system = ms; path = name} : package_info) - = - Format.fprintf - fmt - "@[%s:@ %s@]" + +let dump_location_descriptor (fmt : Format.formatter) + { module_system = ms; path; extension } = + Format.fprintf fmt "@[%s:@ %s:@ %s@]" (string_of_module_system ms) - name + path extension -let dump_package_name fmt (x : package_name) = - match x with + +let dump_package_name fmt (x : package_name) = + match x with | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" - | Pkg_normal s -> Format.pp_print_string fmt s + | Pkg_normal s -> Format.pp_print_string fmt s | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name -let dump_packages_info - (fmt : Format.formatter) - ({name ; module_systems = ls } : t) = - Format.fprintf fmt "@[%a;@ @[%a@]@]" - dump_package_name - name + +let dump_package_info (fmt : Format.formatter) ({ name; locations } : t) = + Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) - dump_package_info - ) ls + dump_location_descriptor) + locations -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -(* Note that package-name has to be exactly the same as - npm package name, otherwise the path resolution will be wrong *) -let query_package_infos - ({name; module_systems } : t) - (module_system : module_system) : info_query = - match name with - | Pkg_empty -> - Package_script - | Pkg_normal name -> - (match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found) - | Pkg_runtime -> - match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = runtime_package_name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +(* Note that package-name has to be exactly the same as npm package name, + otherwise the path resolution will be wrong *) +let query_package_location_by_module_system ({ name; locations } : t) + (module_system : module_system) : query_result = + match name with + | Pkg_empty -> Package_script + | Pkg_normal name -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + | Pkg_runtime -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = runtime_package_name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) -let get_js_path - (x : t ) - module_system - = - match Ext_list.find_first x.module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> k.path +let get_js_path (x : t) module_system = + match + Ext_list.find_first x.locations (fun k -> + compatible k.module_system module_system) + with + | Some k -> k.path | None -> assert false -(* for a single pass compilation, [output_dir] - can be cached -*) -let get_output_dir - (info: t ) - ~package_dir module_system - = - Filename.concat package_dir - (get_js_path info module_system) +(* for a single pass compilation, [output_dir] can be cached *) +let get_output_dir (info : t) ~package_dir module_system = + Filename.concat package_dir (get_js_path info module_system) +let deprecated_set_bs_extension () = + Bs_warnings.warn_deprecated_bs_suffix_flag (); + deprecated_use_bs_extension := true -let add_npm_package_path (packages_info : t) (s : string) : t = - if is_empty packages_info then - Ext_arg.bad_argf "please set package name first using -bs-package-name " - else - let module_system, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ module_system; path] -> - (match module_system_of_string module_system with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" module_system), path - | [path] -> - NodeJS, path - | module_system :: path -> - (match module_system_of_string module_system with - | Some x -> x - | None -> Ext_arg.bad_argf "invalid module system %s" module_system), (String.concat ":" path) - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - { packages_info with module_systems = {module_system; path}::packages_info.module_systems} + +let deprecated_get_default_extension () = + if !deprecated_use_bs_extension then Literals.suffix_bs_js + else Literals.suffix_js + + +(* FIXME: The deprecated -bs-suffix will only affect -bs-package-output flags + passed *after* it. *) +let append_location_descriptor_of_string (packages_info : t) (s : string) : t = + let module_system, path, extension = + match Ext_string.split ~keep_empty:false s ':' with + | [ module_system; path; extension ] -> (module_system, path, extension) + (* Note that, for most users, the default values for [module_system] and + [extension] come not from here, but from [bsb], which always invokes this + with a fully-populated [-bs-package-output]. + + If you're changing the default, make sure both places match! *) + | [ module_system; path ] -> + (module_system, path, deprecated_get_default_extension ()) + | [ path ] -> ("NodeJS", path, deprecated_get_default_extension ()) + | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s + in + let module_system = + match module_system_of_string module_system with + | Some x -> x + | None -> + Ext_arg.bad_argf "invalid module system in -bs-package-output: %s" + module_system + in + { + packages_info with + locations = { module_system; path; extension } :: packages_info.locations; + } (* support es6 modules instead - TODO: enrich ast to support import export - http://www.ecma-international.org/ecma-262/6.0/#sec-imports - For every module, we need [Ident.t] for accessing and [filename] for import, - they are not necessarily the same. - Es6 modules is not the same with commonjs, we use commonjs currently - (play better with node) + TODO: enrich ast to support import export + http://www.ecma-international.org/ecma-262/6.0/#sec-imports For every module, + we need [Ident.t] for accessing and [filename] for import, they are not + necessarily the same. - FIXME: the module order matters? -*) + Es6 modules is not the same with commonjs, we use commonjs currently (play + better with node) + FIXME: the module order matters? *) end module Lam_compat : sig @@ -93609,7 +93451,7 @@ end module Js_cmj_format : sig #1 "js_cmj_format.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -93627,102 +93469,69 @@ module Js_cmj_format : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** Define intemediate format to be serialized for cross module optimization *) +(** In this module, currently only arity information is exported, + - Short term: constant literals are also exported + - Long term: Benefit? since Google Closure Compiler already did such huge + amount of work + TODO: simple expression, literal small function can be stored, but what + would happen if small function captures other environment, for example + {[ let f x = g x ]} + {[ let f = g ]} *) - - -(** Define intemediate format to be serialized for cross module optimization - *) - -(** In this module, - currently only arity information is exported, - - Short term: constant literals are also exported - - Long term: - Benefit? since Google Closure Compiler already did such huge amount of work - TODO: simple expression, literal small function can be stored, - but what would happen if small function captures other environment - for example - - {[ - let f = fun x -> g x - ]} - - {[ - let f = g - ]} -*) - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (* Either constant or closed functor *) + arity : arity; + persistent_closed_lambda : Lam.t option; + (* Either constant or closed functor *) } type effect = string option -type cmj_case = Ext_namespace.file_kind - -type t - +type t -val mk: - values: cmj_value Map_string.t -> - effect: effect -> - npm_package_path: Js_packages_info.t -> - cmj_case:cmj_case -> +val mk : + values:cmj_value Map_string.t -> + effect:effect -> + package_info:Js_package_info.t -> + leading_case:Ext_namespace.leading_case -> t -val query_by_name : - t -> - string -> - arity * Lam.t option +val query_by_name : t -> string -> arity * Lam.t option -val is_pure : - t -> bool +val is_pure : t -> bool -val get_npm_package_path : - t -> - Js_packages_info.t +val get_package_info : t -> Js_package_info.t -val get_cmj_case : - t -> - cmj_case +val get_leading_case : t -> Ext_namespace.leading_case val single_na : arity - - val from_file : string -> t -val from_file_with_digest : - string -> t * Digest.t +val from_file_with_digest : string -> t * Digest.t val from_string : string -> t -(* Note writing the file if its content is not chnaged -*) -val to_file : - string -> check_exists:bool -> t -> unit +(* Note writing the file if its content is not chnaged *) +val to_file : string -> check_exists:bool -> t -> unit + +val pp_cmj : t -> unit -val pp_cmj: t -> unit end = struct #1 "js_cmj_format.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -93740,233 +93549,204 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - [@@@ocaml.warning "+9"] - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array (* TODO: add a magic number *) -type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (** Either constant or closed functor *) -} +type cmj_value = { arity : arity; persistent_closed_lambda : Lam.t option } type effect = string option - +(* we don't force people to use package *) let single_na = Single Lam_arity.na -(** we don't force people to use package *) -type cmj_case = Ext_namespace.file_kind - -type keyed_cmj_values - = (string * cmj_value) array + +type keyed_cmj_values = (string * cmj_value) array type t = { - values : keyed_cmj_values ; + values : keyed_cmj_values; pure : bool; - npm_package_path : Js_packages_info.t ; - cmj_case : cmj_case; + package_info : Js_package_info.t; + leading_case : Ext_namespace.leading_case; } + let empty_values = [||] -let mk ~values ~effect ~npm_package_path ~cmj_case : t = + +let mk ~values ~effect ~package_info ~leading_case : t = { - values = Map_string.to_sorted_array values; - pure = effect = None ; - npm_package_path; - cmj_case + values = Map_string.to_sorted_array values; + pure = effect = None; + package_info; + leading_case; } -let cmj_magic_number = "BUCKLE20171012" -let cmj_magic_number_length = - String.length cmj_magic_number - +let cmj_magic_number = "BUCKLE20200410" +let cmj_magic_number_length = String.length cmj_magic_number let digest_length = 16 (*16 chars *) let verify_magic_in_beg ic = - let buffer = really_input_string ic cmj_magic_number_length in + let buffer = really_input_string ic cmj_magic_number_length in if buffer <> cmj_magic_number then - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ (* Serialization .. *) let from_file name : t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let _digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v + let ic = open_in_bin name in + verify_magic_in_beg ic; + let _digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + v + let from_file_with_digest name : t * Digest.t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v,digest - - -let from_string s : t = - let magic_number = String.sub s 0 cmj_magic_number_length in - if magic_number = cmj_magic_number then - Marshal.from_string s (digest_length + cmj_magic_number_length) - else - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + let ic = open_in_bin name in + verify_magic_in_beg ic; + let digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + (v, digest) + + +let from_string s : t = + let magic_number = String.sub s 0 cmj_magic_number_length in + if magic_number = cmj_magic_number then + Marshal.from_string s (digest_length + cmj_magic_number_length) + else + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ + let fixed_length = cmj_magic_number_length + digest_length -let rec for_sure_not_changed (name : string) (header : string) = - if Sys.file_exists name then - let ic = open_in_bin name in - let holder = - really_input_string ic fixed_length in - close_in ic; - holder = header - else false - -(* This may cause some build system always rebuild - maybe should not be turned on by default -*) -let to_file name ~check_exists (v : t) = - let s = Marshal.to_string v [] in - let cur_digest = Digest.string s in - let header = cmj_magic_number ^ cur_digest in - if not (check_exists && for_sure_not_changed name header) then - let oc = open_out_bin name in - output_string oc header; +let rec for_sure_not_changed (name : string) (header : string) = + if Sys.file_exists name then ( + let ic = open_in_bin name in + let holder = really_input_string ic fixed_length in + close_in ic; + holder = header ) + else false + + +(* This may cause some build system always rebuild maybe should not be turned on + by default *) +let to_file name ~check_exists (v : t) = + let s = Marshal.to_string v [] in + let cur_digest = Digest.string s in + let header = cmj_magic_number ^ cur_digest in + if not (check_exists && for_sure_not_changed name header) then ( + let oc = open_out_bin name in + output_string oc header; output_string oc s; - close_out oc - -let keyComp (a : string) (b,_) = - Map_string.compare_key a b - -let not_found = single_na, None -let get_result midVal = - let (_,cmj_value) = midVal in - cmj_value.arity, - if Js_config.get_cross_module_inline () then cmj_value.persistent_closed_lambda - else None - -let rec binarySearchAux arr lo hi (key : string) = - let mid = (lo + hi)/2 in - let midVal = Array.unsafe_get arr mid in - let c = keyComp key midVal in - if c = 0 then - get_result midVal - else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let loVal = (Array.unsafe_get arr lo) in - if fst loVal = key then get_result loVal - else not_found - else binarySearchAux arr lo mid key - else (* a[lo] =< a[mid] < key <= a[hi] *) - if lo = mid then - let hiVal = (Array.unsafe_get arr hi) in - if fst hiVal = key then get_result hiVal - else not_found + close_out oc ) + + +let keyComp (a : string) (b, _) = Map_string.compare_key a b + +let not_found = (single_na, None) +let get_result midVal = + let _, cmj_value = midVal in + ( cmj_value.arity, + if Js_config.get_cross_module_inline () then + cmj_value.persistent_closed_lambda + else None ) + + +let rec binarySearchAux arr lo hi (key : string) = + let mid = (lo + hi) / 2 in + let midVal = Array.unsafe_get arr mid in + let c = keyComp key midVal in + if c = 0 then get_result midVal + else if c < 0 then + (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = Array.unsafe_get arr lo in + if fst loVal = key then get_result loVal else not_found + else binarySearchAux arr lo mid key + else if (* a[lo] =< a[mid] < key <= a[hi] *) + lo = mid then + let hiVal = Array.unsafe_get arr hi in + if fst hiVal = key then get_result hiVal else not_found else binarySearchAux arr mid hi key -let binarySearch (sorted : keyed_cmj_values) (key : string) = - let len = Array.length sorted in + +let binarySearch (sorted : keyed_cmj_values) (key : string) = + let len = Array.length sorted in if len = 0 then not_found - else - let lo = Array.unsafe_get sorted 0 in - let c = keyComp key lo in + else + let lo = Array.unsafe_get sorted 0 in + let c = keyComp key lo in if c < 0 then not_found else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = keyComp key hi in - if c2 > 0 then not_found - else binarySearchAux sorted 0 (len - 1) key + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = keyComp key hi in + if c2 > 0 then not_found else binarySearchAux sorted 0 (len - 1) key -(* FIXME: better error message when ocamldep - get self-cycle -*) -let query_by_name (cmj_table : t ) name = - let values = cmj_table.values in - binarySearch values name +(* FIXME: better error message when ocamldep get self-cycle *) +let query_by_name (cmj_table : t) name = + let values = cmj_table.values in + binarySearch values name -let is_pure (cmj_table : t ) = - cmj_table.pure -let get_npm_package_path (cmj_table : t) = - cmj_table.npm_package_path +let is_pure (cmj_table : t) = cmj_table.pure -let get_cmj_case (cmj_table : t) = - cmj_table.cmj_case +let get_package_info (cmj_table : t) = cmj_table.package_info +let get_leading_case (cmj_table : t) = cmj_table.leading_case (* start dumping *) -let f fmt = Printf.fprintf stdout fmt - -let pp_cmj_case (cmj_case : cmj_case) : unit = - match cmj_case with - | Little_js -> - f "case : little, .js \n" - | Little_bs -> - f "case : little, .bs.js \n" - | Upper_js -> - f "case: upper, .js \n" - | Upper_bs -> - f "case: upper, .bs.js \n" - -let pp_cmj - ({ values ; pure; npm_package_path ; cmj_case} : t) = - f "package info: %s\n" - (Format.asprintf "%a" Js_packages_info.dump_packages_info npm_package_path) - ; - pp_cmj_case cmj_case; - - f "effect: %s\n" - (if pure then "pure" else "not pure"); - Ext_array.iter values - (fun (k , {arity; persistent_closed_lambda}) -> - match arity with - | Single arity -> - f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); - (match persistent_closed_lambda with - | None -> - f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; +let f fmt = Printf.fprintf stdout fmt + +let pp_leading_case (leading_case : Ext_namespace.leading_case) : unit = + match leading_case with + | Upper -> f "case: upper\n" + | Lower -> f "case: lower\n" + + +let pp_cmj ({ values; pure; package_info; leading_case } : t) = + f "package info: %s\n" + (Format.asprintf "%a" Js_package_info.dump_package_info package_info); + pp_leading_case leading_case; + + f "effect: %s\n" (if pure then "pure" else "not pure"); + Ext_array.iter values (fun (k, { arity; persistent_closed_lambda }) -> + match arity with + | Single arity -> ( + f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); + match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s\n" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end ) - | Submodule xs -> - (match persistent_closed_lambda with - | None -> f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; + f "%s: ======[finish]\n" k ) + | Submodule xs -> + ( match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end - ); - Array.iteri - (fun i arity -> f "%s[%i] : %s \n" - k i - (Format.asprintf "%a" Lam_arity.print arity )) - xs - ) + f "%s: ======[finish]\n" k ); + Array.iteri + (fun i arity -> + f "%s[%i] : %s \n" k i + (Format.asprintf "%a" Lam_arity.print arity)) + xs) + end module Js_cmj_datasets : sig #1 "js_cmj_datasets.mli" @@ -103023,6 +102803,7 @@ val imports : Ext_pp.t -> (Ident.t * string) list -> Ext_pp_scope.t + end = struct #1 "js_dump_import_export.ml" (* Copyright (C) 2017 Authors of BuckleScript @@ -103907,8 +103688,8 @@ let find_package_json_dir cwd = let package_dir = lazy (find_package_json_dir (Lazy.force cwd)) end -module Js_packages_state : sig -#1 "js_packages_state.mli" +module Js_current_package_info : sig +#1 "js_current_package_info.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -103933,19 +103714,16 @@ module Js_packages_state : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val set_package_name : string -> unit +val set_package_map : string -> unit -val set_package_name : string -> unit - -val set_package_map : string -> unit +val get_packages_info : unit -> Js_package_info.t -val get_packages_info : - unit -> Js_packages_info.t +val append_location_descriptor_of_string : string -> unit -val update_npm_package_path : - string -> unit end = struct -#1 "js_packages_state.ml" +#1 "js_current_package_info.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -103970,30 +103748,27 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let packages_info = ref Js_package_info.empty -let packages_info = ref Js_packages_info.empty +let set_package_name name = + if Js_package_info.is_empty !packages_info then + packages_info := Js_package_info.from_name name + else Ext_arg.bad_argf "duplicated flag for -bs-package-name" +let set_package_map module_name = + Clflags.dont_record_crc_unit := Some module_name; + Clflags.open_modules := module_name :: !Clflags.open_modules -let set_package_name name = - if Js_packages_info.is_empty !packages_info then - packages_info := Js_packages_info.from_name name + +let append_location_descriptor_of_string s = + if Js_package_info.is_empty !packages_info then + Ext_arg.bad_argf "please set package name first using -bs-package-name or -bs-ns" else - Ext_arg.bad_argf "duplicated flag for -bs-package-name" - -let set_package_map module_name = - (* set_package_name name ; - let module_name = Ext_namespace.namespace_of_package_name name in *) - Clflags.dont_record_crc_unit := Some module_name; - Clflags.open_modules := - module_name:: - !Clflags.open_modules - -let update_npm_package_path s = - packages_info := - Js_packages_info.add_npm_package_path !packages_info s + packages_info := Js_package_info.append_location_descriptor_of_string !packages_info s + +let get_packages_info () = !packages_info -let get_packages_info () = !packages_info end module Ext_modulename : sig #1 "ext_modulename.mli" @@ -104320,7 +104095,7 @@ val find_cmj_exn : end = struct #1 "js_cmj_load.ml" (* Copyright (C) Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -104338,41 +104113,35 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* strategy: - If not installed, use the distributed [cmj] files, - make sure that the distributed files are platform independent -*) +(* strategy: If not installed, use the distributed [cmj] files, make sure that + the distributed files are platform independent *) +type path = string +type cmj_load_info = { cmj_table : Js_cmj_format.t; cmj_path : path } -type path = string -type cmj_load_info = { - cmj_table : Js_cmj_format.t ; - cmj_path : path ; -} - -let find_cmj_exn file : cmj_load_info = +let find_cmj_exn file : cmj_load_info = let target = Ext_string.uncapitalize_ascii (Filename.basename file) in match Map_string.find_exn !Js_cmj_datasets.data_sets target with - | v - -> - begin match Lazy.force v with - | exception _ - -> - Ext_log.warn __LOC__ - "@[%s corrupted in database, when looking %s while compiling %s please update @]" file target !Location.input_name ; - Bs_exception.error (Cmj_not_found file) - | v -> {cmj_path = "BROWSER"; cmj_table = v} - (* see {!Js_packages_info.string_of_module_id} *) - end - | exception Not_found - -> - Bs_exception.error (Cmj_not_found file) + | v -> ( + match Lazy.force v with + | exception _ -> + Ext_log.warn __LOC__ + "@[%s corrupted in database, when looking %s while compiling %s \ + please update @]" + file target !Location.input_name; + Bs_exception.error (Cmj_not_found file) + | v -> + { cmj_path = "BROWSER"; cmj_table = v } + (* see {!Js_package_info.string_of_module_id} *) ) + | exception Not_found -> Bs_exception.error (Cmj_not_found file) + + end module Hash : sig @@ -109432,7 +109201,7 @@ end module Lam_compile_env : sig #1 "lam_compile_env.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109450,96 +109219,69 @@ module Lam_compile_env : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** Helper for global Ocaml module index into meaningful names *) - - - - +(** Helper for global Ocaml module index into meaningful names *) type ident_info = { name : string; arity : Js_cmj_format.arity; - closed_lambda : Lam.t option -} - + closed_lambda : Lam.t option; +} +val reset : unit -> unit +val add_js_module : External_ffi_types.module_bind_name -> string -> Ident.t +(** [add_js_module hint_name module_name] Given a js module name and hint name, + assign an id to it we also bookkeep it as [External] dependency. -val reset : unit -> unit + Note the complexity lies in that we should consolidate all same external + dependencies into a single dependency. -(** - [add_js_module hint_name module_name] - Given a js module name and hint name, assign an id to it - we also bookkeep it as [External] dependency. + The strategy is that we first create a [Lam_module_ident.t] and query it if + already exists in [cache_tbl], if it already exists, we discard the freshly + made one, and use the cached one, otherwise, use the freshly made one + instead - Note the complexity lies in that we should consolidate all - same external dependencies into a single dependency. - - The strategy is that we first create a [Lam_module_ident.t] - and query it if already exists in [cache_tbl], if it already - exists, we discard the freshly made one, and use the cached one, - otherwise, use the freshly made one instead + Invariant: any [id] as long as put in the [cached_tbl] should be always + valid, *) - Invariant: - any [id] as long as put in the [cached_tbl] should be always valid, -*) -val add_js_module : - External_ffi_types.module_bind_name -> string -> Ident.t +(* The other dependencies are captured by querying either when [access] or when + expansion, however such dependency can be removed after inlining etc. + When we register such compile time dependency we classified it as Visit (ml), + Builtin(built in js), External() -(* The other dependencies are captured by querying - either when [access] or when expansion, - however such dependency can be removed after inlining etc. - - When we register such compile time dependency we classified - it as - Visit (ml), Builtin(built in js), External() - - For external, we never remove, we only consider - remove dependency for Runtime and Visit, so - when compile OCaml to Javascript, we only need - pay attention to for those modules are actually used or not -*) -(** - [query_external_id_info id pos env found] - will raise if not found -*) -val query_external_id_info : - Ident.t -> - string -> - ident_info + For external, we never remove, we only consider remove dependency for Runtime + and Visit, so when compile OCaml to Javascript, we only need pay attention to + for those modules are actually used or not *) +val query_external_id_info : Ident.t -> string -> ident_info +(** [query_external_id_info id pos env found] will raise if not found *) val is_pure_module : Lam_module_ident.t -> bool +val get_package_path_from_cmj : + Lam_module_ident.t -> string * Js_package_info.t * Ext_namespace.leading_case -val get_package_path_from_cmj : - Lam_module_ident.t -> - (string * Js_packages_info.t * Js_cmj_format.cmj_case) - - +val get_required_modules : + Lam_module_ident.Hash_set.t -> + Lam_module_ident.Hash_set.t -> + Lam_module_ident.t list +(** The second argument is mostly from [runtime] modules -(* The second argument is mostly from [runtime] modules will change the input [hard_dependencies] - [get_required_modules extra hard_dependencies] - [extra] maybe removed if it is pure and not in [hard_dependencies] -*) -val get_required_modules : - Lam_module_ident.Hash_set.t -> - Lam_module_ident.Hash_set.t -> - Lam_module_ident.t list + + [get_required_modules extra hard_dependencies] - [extra] maybe removed if it + is pure and not in [hard_dependencies] *) end = struct #1 "lam_compile_env.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109557,206 +109299,141 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - - -module E = Js_exp_make +module E = Js_exp_make module S = Js_stmt_make - -type env_value = +type env_value = | Ml of Js_cmj_load.cmj_load_info - | Runtime of Js_cmj_load.cmj_load_info - (** - [Runtime (pure, path, cmj_format)] - A built in module probably from our runtime primitives, - so it does not have any [signature] - - *) - | External - (** Also a js file, but this belong to third party - *) - - - + | Runtime of Js_cmj_load.cmj_load_info + (** [Runtime (pure, path, cmj_format)] A built in module probably from our + runtime primitives, so it does not have any [signature] *) + | External (** Also a js file, but this belong to third party *) type ident_info = { name : string; - arity : Js_cmj_format.arity; - closed_lambda : Lam.t option + arity : Js_cmj_format.arity; + closed_lambda : Lam.t option; } -(* - refer: [Env.find_pers_struct] - [ find_in_path_uncap !load_path (name ^ ".cmi")] -*) - +(* refer: [Env.find_pers_struct] [ find_in_path_uncap !load_path (name ^ + ".cmi")] *) +let cached_tbl : env_value Lam_module_ident.Hash.t = + Lam_module_ident.Hash.create 31 -let cached_tbl : env_value Lam_module_ident.Hash.t - = Lam_module_ident.Hash.create 31 -let (+>) = Lam_module_ident.Hash.add cached_tbl +let ( +> ) = Lam_module_ident.Hash.add cached_tbl (* For each compilation we need reset to make it re-entrant *) -let reset () = +let reset () = Translmod.reset (); - Lam_module_ident.Hash.clear cached_tbl - - - - - -(** We should not provide "#moduleid" as output - since when we print it in the end, it will - be escaped quite ugly -*) -let add_js_module - (hint_name : External_ffi_types.module_bind_name) - (module_name : string) : Ident.t - = - let id = - Ident.create - (match hint_name with - | Phint_name hint_name -> - Ext_string.capitalize_ascii hint_name - (* make sure the module name is capitalized - TODO: maybe a warning if the user hint is not good - *) - | Phint_nothing -> - Ext_modulename.js_id_name_of_hint_name module_name - ) + Lam_module_ident.Hash.clear cached_tbl + + +(** We should not provide "#moduleid" as output since when we print it in the + end, it will be escaped quite ugly *) +let add_js_module (hint_name : External_ffi_types.module_bind_name) + (module_name : string) : Ident.t = + let id = + Ident.create + ( match hint_name with + | Phint_name hint_name -> Ext_string.capitalize_ascii hint_name + (* make sure the module name is capitalized TODO: maybe a warning if the + user hint is not good *) + | Phint_nothing -> Ext_modulename.js_id_name_of_hint_name module_name ) in - let lam_module_ident = - Lam_module_ident.of_external id module_name in - match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with + let lam_module_ident = Lam_module_ident.of_external id module_name in + match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with | None -> - Lam_module_ident.Hash.add - cached_tbl - lam_module_ident - External; - id - | Some old_key -> - old_key.id - - - - + Lam_module_ident.Hash.add cached_tbl lam_module_ident External; + id + | Some old_key -> old_key.id let query_external_id_info (module_id : Ident.t) (name : string) : ident_info = - let oid = Lam_module_ident.of_ml module_id in - let cmj_table = - match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - let cmj_load_info = - Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in - oid +> Ml cmj_load_info ; - cmj_load_info.cmj_table - | Some (Ml { cmj_table } ) - -> cmj_table + let oid = Lam_module_ident.of_ml module_id in + let cmj_table = + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> + let cmj_load_info = + Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) + in + oid +> Ml cmj_load_info; + cmj_load_info.cmj_table + | Some (Ml { cmj_table }) -> cmj_table | Some (Runtime _) -> assert false - | Some External -> assert false in - let arity , closed_lambda = - Js_cmj_format.query_by_name cmj_table name + | Some External -> assert false in - { - name; - arity; - closed_lambda - (* TODO shall we cache the arity ?*) - } - - - - - - - - + let arity, closed_lambda = Js_cmj_format.query_by_name cmj_table name in + { name; arity; closed_lambda (* TODO shall we cache the arity ?*) } +let get_package_path_from_cmj (id : Lam_module_ident.t) = + match Lam_module_ident.Hash.find_opt cached_tbl id with + | Some (Ml { cmj_table; cmj_path }) -> + ( cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) + | Some (External | Runtime _) -> + assert false + (* called by {!Js_name_of_module_id.string_of_module_id} can not be + External *) + | None -> ( + match id.kind with + | Runtime | External _ -> assert false + | Ml -> + let ({ Js_cmj_load.cmj_table } as cmj_load_info) = + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name id ^ Literals.suffix_cmj) + in + id +> Ml cmj_load_info; + ( cmj_load_info.cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) ) -let get_package_path_from_cmj - ( id : Lam_module_ident.t) - = - match Lam_module_ident.Hash.find_opt cached_tbl id with - | Some (Ml {cmj_table ; cmj_path}) -> - (cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - | Some ( - External | - Runtime _ ) -> - assert false - (* called by {!Js_name_of_module_id.string_of_module_id} - can not be External - *) - | None -> - begin match id.kind with - | Runtime - | External _ -> assert false - | Ml -> - let ({Js_cmj_load.cmj_table} as cmj_load_info) = - Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in - id +> Ml cmj_load_info; - (cmj_load_info.cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - end let add = Lam_module_ident.Hash_set.add - - (* Conservative interface *) -let is_pure_module (oid : Lam_module_ident.t) = - match oid.kind with - | Runtime -> true +let is_pure_module (oid : Lam_module_ident.t) = + match oid.kind with + | Runtime -> true | External _ -> false - | Ml -> - begin match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - begin - match Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) with - | cmj_load_info -> - oid +> Ml cmj_load_info ; - Js_cmj_format.is_pure cmj_load_info.cmj_table - | exception _ -> false - end - | Some (Ml{cmj_table}|Runtime {cmj_table}) -> - Js_cmj_format.is_pure cmj_table - | Some External -> false - end - + | Ml -> ( + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> ( + match + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name oid ^ Literals.suffix_cmj) + with + | cmj_load_info -> + oid +> Ml cmj_load_info; + Js_cmj_format.is_pure cmj_load_info.cmj_table + | exception _ -> false ) + | Some (Ml { cmj_table } | Runtime { cmj_table }) -> + Js_cmj_format.is_pure cmj_table + | Some External -> false ) -let get_required_modules - extras - (hard_dependencies - : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list = - Lam_module_ident.Hash.iter cached_tbl (fun id _ -> - if not @@ is_pure_module id - then add hard_dependencies id); - Lam_module_ident.Hash_set.iter extras (fun id -> - (if not @@ is_pure_module id - then add hard_dependencies id : unit) - ); + +let get_required_modules extras + (hard_dependencies : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list + = + Lam_module_ident.Hash.iter cached_tbl (fun id _ -> + if not @@ is_pure_module id then add hard_dependencies id); + Lam_module_ident.Hash_set.iter extras (fun id -> + (if not @@ is_pure_module id then add hard_dependencies id : unit)); Lam_module_ident.Hash_set.elements hard_dependencies end module Js_name_of_module_id : sig #1 "js_name_of_module_id.mli" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109774,29 +109451,27 @@ module Js_name_of_module_id : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** - generate the mdoule path so that it can be spliced here: - {[ - var Xx = require("package/path/to/xx.js") - ]} - Note that it has to be consistent to how it is generated -*) - -val string_of_module_id : +val string_of_module_id : Lam_module_ident.t -> output_dir:string -> - Js_packages_info.module_system -> + ext:string -> + Js_package_info.module_system -> string +(** generate the mdoule path so that it can be spliced here: + + {[ var Xx = require "package/path/to/xx.js" ]} + + Note that it has to be consistent to how it is generated *) + end = struct #1 "js_name_of_module_id.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -109814,195 +109489,182 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* -let (=) (x : int) (y:float) = assert false -*) -(* "xx/lib/ocaml/js.cmj" - Enhancement: This can be delegated to build system -*) -let runtime_package_path : string Lazy.t = - lazy (Filename.dirname (Filename.dirname - (Filename.dirname - (match Config_util.find_opt "js.cmj" with - | None -> assert false - | Some x -> x)))) +(* "xx/lib/ocaml/js.cmj" Enhancement: This can be delegated to build system *) +let runtime_package_path : string Lazy.t = + lazy + (Filename.dirname + (Filename.dirname + (Filename.dirname + ( match Config_util.find_opt "js.cmj" with + | None -> assert false + | Some x -> x )))) -let (//) = Filename.concat +let ( // ) = Filename.concat -let fix_path_for_windows : string -> string = +let fix_path_for_windows : string -> string = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_backward_slash - else fun s -> s - - -let get_runtime_module_path - (dep_module_id : Lam_module_ident.t) - (current_package_info : Js_packages_info.t) - module_system = - let current_info_query = - Js_packages_info.query_package_infos current_package_info - module_system in - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name Little_js in - match current_info_query with - | Package_not_found -> assert false - | Package_script -> - Js_packages_info.runtime_package_path module_system js_file - | Package_found pkg -> - let dep_path = - "lib" // Js_packages_info.runtime_dir_of_module_system module_system in - if Js_packages_info.is_runtime_package current_package_info then - Ext_path.node_rebase_file - ~from:pkg.rel_path - ~to_:dep_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - match module_system with - | NodeJS | Es6 -> - Js_packages_info.runtime_package_path module_system js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system ) - (Lazy.force runtime_package_path // dep_path // js_file) + else fun s -> s +let get_runtime_module_path (dep_module_id : Lam_module_ident.t) + (current_package_info : Js_package_info.t) module_system = + let loc = + Js_package_info.query_package_location_by_module_system current_package_info + module_system + in + let js_file = + Ext_namespace.js_filename_of_modulename ~name:dep_module_id.id.name + ~ext:".js" Lower + in + match loc with + | Package_not_found -> assert false + | Package_script -> Js_package_info.runtime_package_path module_system js_file + | Package_found pkg -> ( + let dep_path = + "lib" // Js_package_info.runtime_dir_of_module_system module_system + in + if Js_package_info.is_runtime_package current_package_info then + Ext_path.node_rebase_file ~from:pkg.rel_path ~to_:dep_path js_file + (* TODO: we assume that both [x] and [path] could only be relative path + which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + Js_package_info.runtime_package_path module_system js_file + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package path + calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + (Lazy.force runtime_package_path // dep_path // js_file) ) + (* [output_dir] is decided by the command line argument *) -let string_of_module_id - (dep_module_id : Lam_module_ident.t) - ~(output_dir : string ) - (module_system : Js_packages_info.module_system) - : string = - let current_package_info = Js_packages_state.get_packages_info () in - fix_path_for_windows ( - match dep_module_id.kind with +let string_of_module_id (dep_module_id : Lam_module_ident.t) + ~(output_dir : string) ~(ext : string) + (module_system : Js_package_info.module_system) : string = + let current_package_info = Js_current_package_info.get_packages_info () in + fix_path_for_windows + ( match dep_module_id.kind with | External name -> name (* the literal string for external package *) - (** This may not be enough, - 1. For cross packages, we may need settle - down a single js package - 2. We may need es6 path for dead code elimination - But frankly, very few JS packages have no dependency, - so having plugin may sound not that bad - *) - | Runtime -> - get_runtime_module_path dep_module_id current_package_info module_system - | Ml -> - let current_info_query = - Js_packages_info.query_package_infos - current_package_info - module_system - in - match Lam_compile_env.get_package_path_from_cmj dep_module_id with - | (cmj_path, dep_package_info, little) -> - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name little in - let dep_info_query = - Js_packages_info.query_package_infos dep_package_info module_system - in - match dep_info_query, current_info_query with - | Package_not_found , _ -> - Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) - | Package_script , Package_found _ -> - Bs_exception.error (Dependency_script_module_dependent_not js_file) - | (Package_script | Package_found _ ), Package_not_found -> assert false - - | Package_found pkg, Package_script - -> - - pkg.pkg_rel_path // js_file - - - | Package_found dep_pkg, - Package_found cur_pkg -> - if Js_packages_info.same_package_by_name current_package_info dep_package_info then - Ext_path.node_rebase_file - ~from:cur_pkg.rel_path - ~to_:dep_pkg.rel_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - begin match module_system with - | NodeJS | Es6 -> + (* This may not be enough, + + + For cross packages, we may need settle down a single js package + We + may need es6 path for dead code elimination + + But frankly, very few JS packages have no dependency, so having plugin + may sound not that bad *) + | Runtime -> + get_runtime_module_path dep_module_id current_package_info module_system + | Ml -> ( + let query = Js_package_info.query_package_location_by_module_system in + let current_loc = query current_package_info module_system in + match Lam_compile_env.get_package_path_from_cmj dep_module_id with + | cmj_path, dep_package_info, case -> ( + let dep_loc = query dep_package_info module_system in + match (dep_loc, current_loc) with + | Package_not_found, _ -> + Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) + | Package_script, Package_found _ -> + let js_file = + Ext_namespace.js_filename_of_modulename + (* FIXME: Unsure how to infer a useful file-extension here. *) + ~name:dep_module_id.id.name ~ext:"" case + in + Bs_exception.error + (Dependency_script_module_dependent_not js_file) + | (Package_script | Package_found _), Package_not_found -> + assert false + | Package_found dep_pkg, Package_script -> + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in dep_pkg.pkg_rel_path // js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - - begin - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system - ) - ((Filename.dirname - (Filename.dirname (Filename.dirname cmj_path))) // dep_pkg.rel_path // js_file) - end - end - | Package_script, Package_script - -> - match Config_util.find_opt js_file with - | Some file -> - let basename = Filename.basename file in - let dirname = Filename.dirname file in - Ext_path.node_rebase_file - ~from:( - Ext_path.absolute_cwd_path - output_dir) - ~to_:( - Ext_path.absolute_cwd_path - - dirname) - basename - | None -> - Bs_exception.error (Js_not_found js_file)) + | Package_found dep_pkg, Package_found cur_pkg -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in + if + Js_package_info.same_package_by_name current_package_info + dep_package_info + then + Ext_path.node_rebase_file ~from:cur_pkg.rel_path + ~to_:dep_pkg.rel_path js_file + (* TODO: we assume that both [x] and [path] could only be + relative path which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + + dep_pkg.pkg_rel_path // js_file + + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package + path calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + ( Filename.dirname + (Filename.dirname (Filename.dirname cmj_path)) + // dep_pkg.rel_path // js_file ) ) + | Package_script, Package_script -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext case + in + match Config_util.find_opt js_file with + | Some file -> + let basename = Filename.basename file in + let dirname = Filename.dirname file in + Ext_path.node_rebase_file + ~from:(Ext_path.absolute_cwd_path output_dir) + ~to_:(Ext_path.absolute_cwd_path dirname) + basename + | None -> Bs_exception.error (Js_not_found js_file) ) ) ) ) - (* Override it in browser *) - -let string_of_module_id_in_browser (x : Lam_module_ident.t) = - match x.kind with - | External name -> name - | Runtime | Ml -> - "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" -let string_of_module_id - (id : Lam_module_ident.t) - ~output_dir:(_:string) - (_module_system : Js_packages_info.module_system) - = string_of_module_id_in_browser id + +let string_of_module_id_in_browser (x : Lam_module_ident.t) = + match x.kind with + | External name -> name + | Runtime | Ml -> + "./stdlib/" ^ Ext_string.uncapitalize_ascii x.id.name ^ ".js" + + +let string_of_module_id (id : Lam_module_ident.t) ~output_dir:(_ : string) + ~ext:(_ : string) (_module_system : Js_package_info.module_system) = + string_of_module_id_in_browser id end module Js_dump_program : sig #1 "js_dump_program.mli" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -110020,35 +109682,34 @@ module Js_dump_program : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** only used for debugging purpose *) val dump_program : J.program -> out_channel -> unit - +(** only used for debugging purpose *) val pp_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - Ext_pp.t -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + Ext_pp.t -> unit - val dump_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - out_channel -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + out_channel -> unit - + end = struct #1 "js_dump_program.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -110066,133 +109727,99 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) module P = Ext_pp -module L = Js_dump_lit +module L = Js_dump_lit +let empty_explanation = + "/* This output is empty. Its source's type definitions, externals and/or \ + unused code got optimized away. */\n" +let program_is_empty (x : J.program) = + match x with + | { block = []; exports = []; export_set = _ } -> true + | _ -> false -let empty_explanation = - "/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */\n" -let program_is_empty (x : J.program) = - match x with - | { - block = []; - exports = []; - export_set = _ - } -> true - | _ -> false +let deps_program_is_empty (x : J.deps_program) = + match x with + | { modules = []; program; side_effect = None } -> program_is_empty program + | _ -> false -let deps_program_is_empty (x : J.deps_program) = - match x with - | { modules = []; - program ; - side_effect = None - } -> program_is_empty program - | _ -> false -let program f cxt ( x : J.program ) = +let program f cxt (x : J.program) = P.force_newline f; - let cxt = Js_dump.statement_list true cxt f x.block in + let cxt = Js_dump.statement_list true cxt f x.block in P.force_newline f; Js_dump_import_export.exports cxt f x.exports -let dump_program (x : J.program) oc = - ignore (program (P.from_channel oc) Ext_pp_scope.empty x ) - -let node_program ~output_dir f ( x : J.deps_program) = - P.string f L.strict_directive; - P.newline f ; - let cxt = - Js_dump_import_export.requires - L.require - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id - x - ~output_dir - NodeJS - )) - in - program f cxt x.program +let dump_program (x : J.program) oc = + ignore (program (P.from_channel oc) Ext_pp_scope.empty x) +let node_program ~output_dir ~ext f (x : J.deps_program) = + P.string f L.strict_directive; + P.newline f; + let cxt = + Js_dump_import_export.requires L.require Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext NodeJS + ))) + in + program f cxt x.program -let es6_program ~output_dir fmt f ( x : J.deps_program) = - let cxt = - Js_dump_import_export.imports - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id x ~output_dir - fmt - )) +let es6_program ~output_dir ~ext fmt f (x : J.deps_program) = + let cxt = + Js_dump_import_export.imports Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext fmt ))) in - let () = P.force_newline f in - let cxt = Js_dump.statement_list true cxt f x.program.block in - let () = P.force_newline f in + let () = P.force_newline f in + let cxt = Js_dump.statement_list true cxt f x.program.block in + let () = P.force_newline f in Js_dump_import_export.es6_export cxt f x.program.exports - (** Make sure github linguist happy + {[ require('Linguist') Linguist::FileBlob.new('jscomp/test/test_u.js').generated? - ]} -*) + ]} *) -let pp_deps_program - ~output_prefix - (kind : Js_packages_info.module_system ) - (program : J.deps_program) (f : Ext_pp.t) = - if not !Js_config.no_version_header then - begin - P.string f Bs_version.header; - P.newline f - end ; - if deps_program_is_empty program then - P.string f empty_explanation +let pp_deps_program ~output_prefix ~ext (kind : Js_package_info.module_system) + (program : J.deps_program) (f : Ext_pp.t) = + if not !Js_config.no_version_header then ( + P.string f Bs_version.header; + P.newline f ); + if deps_program_is_empty program then P.string f empty_explanation (* This is empty module, it won't be referred anywhere *) - else - let output_dir = Filename.dirname output_prefix in - begin - ignore (match kind with - | Es6 | Es6_global -> - es6_program ~output_dir kind f program - | NodeJS -> - node_program ~output_dir f program - ) ; - P.newline f ; - P.string f ( - match program.side_effect with - | None -> "/* No side effect */" - | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); - P.newline f; - P.flush f () - end - + else + let output_dir = Filename.dirname output_prefix in + ignore + ( match kind with + | Es6 | Es6_global -> es6_program ~output_dir ~ext kind f program + | NodeJS -> node_program ~output_dir ~ext f program ); + P.newline f; + P.string f + ( match program.side_effect with + | None -> "/* No side effect */" + | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); + P.newline f; + P.flush f () -let dump_deps_program - ~output_prefix - kind - x - (oc : out_channel) = - pp_deps_program ~output_prefix kind x (P.from_channel oc) +let dump_deps_program ~output_prefix ~ext kind x (oc : out_channel) = + pp_deps_program ~output_prefix ~ext kind x (P.from_channel oc) end module Jsoo_common : sig @@ -128723,7 +128350,7 @@ end module Lam_stats_export : sig #1 "lam_stats_export.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128741,32 +128368,25 @@ module Lam_stats_export : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val get_dependent_module_effect : + Lam_stats.t -> string option -> Lam_module_ident.t list -> string option - - -val get_dependent_module_effect: - Lam_stats.t -> - string option -> - Lam_module_ident.t list -> - string option - -val export_to_cmj : +val export_to_cmj : Lam_stats.t -> Js_cmj_format.effect -> Lam.t Map_ident.t -> - Js_cmj_format.cmj_case -> + Ext_namespace.leading_case -> Js_cmj_format.t - end = struct #1 "lam_stats_export.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128784,141 +128404,109 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let pp = Format.fprintf - - - - -let pp = Format.fprintf (* we should exclude meaninglist names and do the convert as well *) - -(* let meaningless_names = ["*opt*"; "param";] *) - - +(* let meaningless_names = ["*opt*"; "param";] *) let single_na = Js_cmj_format.single_na -let values_of_export - (meta : Lam_stats.t) - (export_map : Lam.t Map_ident.t) - : Js_cmj_format.cmj_value Map_string.t - = - Ext_list.fold_left meta.exports Map_string.empty - (fun acc x -> - let arity : Js_cmj_format.arity = - match Hash_ident.find_opt meta.ident_tbl x with - | Some (FunctionId {arity ; _}) -> Single arity - | Some (ImmutableBlock(elems)) -> - (* FIXME: field name for dumping*) - Submodule(Ext_array.map elems (fun x -> - match x with - | NA -> Lam_arity.na - | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam) - ) - | Some _ - | None -> - begin match Map_ident.find_opt export_map x with - | Some (Lprim {primitive = Pmakeblock (_,_, Immutable); args }) -> - Submodule (Ext_array.of_list_map args (fun lam -> - Lam_arity_analysis.get_arity meta lam)) - | Some _ - | None -> single_na - end - in - let persistent_closed_lambda = - if not !Js_config.cross_module_inline then None - else match Map_ident.find_opt export_map x with - | Some lambda -> - if Lam_analysis.safe_to_inline lambda - (* when inlning a non function, we have to be very careful, - only truly immutable values can be inlined - *) - then - if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *) - then - if Lam_closure.is_closed lambda (* TODO: seriealize more*) - then Some lambda - else None - else - let lam_size = Lam_analysis.size lambda in - (* TODO: - 1. global need re-assocate when do the beta reduction - 2. [lambda_exports] is not precise - *) - let free_variables = - Lam_closure.free_variables Set_ident.empty Map_ident.empty lambda in - if lam_size < Lam_analysis.small_inline_size && - Map_ident.is_empty free_variables - then - begin - Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name ; - Some lambda - end - else None - else - None - | None -> None in - Map_string.add acc x.name Js_cmj_format.{arity ; persistent_closed_lambda } - ) +let values_of_export (meta : Lam_stats.t) (export_map : Lam.t Map_ident.t) : + Js_cmj_format.cmj_value Map_string.t = + Ext_list.fold_left meta.exports Map_string.empty (fun acc x -> + let arity : Js_cmj_format.arity = + match Hash_ident.find_opt meta.ident_tbl x with + | Some (FunctionId { arity; _ }) -> Single arity + | Some (ImmutableBlock elems) -> + (* FIXME: field name for dumping*) + Submodule + (Ext_array.map elems (fun x -> + match x with + | NA -> Lam_arity.na + | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> ( + match Map_ident.find_opt export_map x with + | Some (Lprim { primitive = Pmakeblock (_, _, Immutable); args }) -> + Submodule + (Ext_array.of_list_map args (fun lam -> + Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> single_na ) + in + let persistent_closed_lambda = + if not !Js_config.cross_module_inline then None + else + match Map_ident.find_opt export_map x with + | Some lambda -> + if + Lam_analysis.safe_to_inline lambda + (* when inlning a non function, we have to be very careful, only + truly immutable values can be inlined *) + then + if + Lam_inline_util.should_be_functor x.name lambda + (* can also be submodule *) + then + if Lam_closure.is_closed lambda (* TODO: seriealize more*) + then Some lambda + else None + else + let lam_size = Lam_analysis.size lambda in + (* TODO: 1. global need re-assocate when do the beta reduction + 2. [lambda_exports] is not precise *) + let free_variables = + Lam_closure.free_variables Set_ident.empty Map_ident.empty + lambda + in + if + lam_size < Lam_analysis.small_inline_size + && Map_ident.is_empty free_variables + then ( + Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name; + Some lambda ) + else None + else None + | None -> None + in + Map_string.add acc x.name + Js_cmj_format.{ arity; persistent_closed_lambda }) -(* ATTENTION: all runtime modules, if it is not hard required, - it should be okay to not reference it -*) -let get_dependent_module_effect - (meta : Lam_stats.t) - (maybe_pure : string option) - (external_ids : Lam_module_ident.t list) = - if maybe_pure = None then - let non_pure_module = - Ext_list.find_first_not external_ids - Lam_compile_env.is_pure_module - in - Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) - else - maybe_pure +(* ATTENTION: all runtime modules, if it is not hard required, it should be okay + to not reference it *) +let get_dependent_module_effect (meta : Lam_stats.t) + (maybe_pure : string option) (external_ids : Lam_module_ident.t list) = + if maybe_pure = None then + let non_pure_module = + Ext_list.find_first_not external_ids Lam_compile_env.is_pure_module + in + Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) + else maybe_pure -(* Note that - [lambda_exports] is - lambda expression to be exported - for the js backend, we compile to js - for the inliner, we try to seriaize it -- - relies on other optimizations to make this happen - {[ - exports.Make = function () {.....} - ]} - TODO: check that we don't do this in browser environment -*) -let export_to_cmj - (meta : Lam_stats.t ) - effect - export_map - cmj_case - : Js_cmj_format.t = - let values = values_of_export meta export_map in - - Js_cmj_format.mk - ~values - ~effect - ~npm_package_path: (Js_packages_state.get_packages_info ()) - ~cmj_case - (* FIXME: make sure [-o] would not change its case - add test for ns/non-ns - *) - +(* Note that [lambda_exports] is lambda expression to be exported for the js + backend, we compile to js for the inliner, we try to seriaize it -- relies on + other optimizations to make this happen {[ exports.Make = function () {.....} + ]} TODO: check that we don't do this in browser environment *) +let export_to_cmj (meta : Lam_stats.t) effect export_map + (leading_case : Ext_namespace.leading_case) : Js_cmj_format.t = + let values = values_of_export meta export_map in + (* FIXME: make sure [-o] would not change its case *) + (* FIXME: add test for ns/non-ns *) + Js_cmj_format.mk ~values ~effect + ~package_info:(Js_current_package_info.get_packages_info ()) + ~leading_case end module Lam_compile_main : sig #1 "lam_compile_main.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128936,40 +128524,25 @@ module Lam_compile_main : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** BuckleScript entry point in the OCaml compiler *) +val compile : string -> Lambda.lambda -> J.deps_program +(** Compile and register the hook of function to compile a lambda to JS IR + For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name + ()} *) - - - - -(** BuckleScript entry point in the OCaml compiler *) - -(** Compile and register the hook of function to compile a lambda to JS IR - *) - -(** For toplevel, [filename] is [""] which is the same as - {!Env.get_unit_name ()} - *) -val compile : - string -> - Lambda.lambda -> - J.deps_program - -val lambda_as_module : - J.deps_program -> - string -> - unit +val lambda_as_module : J.deps_program -> string -> unit end = struct #1 "lam_compile_main.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -128987,290 +128560,240 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +module E = Js_exp_make +module S = Js_stmt_make +let get_leading_case output_prefix : Ext_namespace.leading_case = + if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Lower + else Upper +let compile_group (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = + match x with + (* We need: 1. [E.builtin_dot] for javascript builtin, 2. [E.mldot] *) + (* ATTENTION: check {!Lam_compile_global} for consistency *) + (* Special handling for values in [Pervasives] *) + (* we delegate [stdout, stderr, and stdin] into [caml_io] module, the + motivation is to help dead code eliminatiion, it's helpful to make those + parts pure (not a function call), then it can be removed if unused *) + + (* QUICK hack to make hello world example nicer, Note the arity of + [print_endline] is already analyzed before, so it should be safe *) + | Single (kind, id, lam) -> + (* let lam = Optimizer.simplify_lets [] lam in *) + (* can not apply again, it's wrong USE it with care *) + (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) + Lam_compile.compile_lambda + { + continuation = Declare (kind, id); + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam + | Recursive id_lams -> + Lam_compile.compile_recursive_lets + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + id_lams + | Nop lam -> + (* TODO: Side effect callls, log and see statistics *) + Lam_compile.compile_lambda + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam +(* Also need analyze its depenency is pure or not *) +let no_side_effects (rest : Lam_group.t list) : string option = + Ext_list.find_opt rest (fun x -> + match x with + | Single (kind, id, body) -> ( + match kind with + | Strict | Variable -> + if not @@ Lam_analysis.no_side_effects body then + Some (Printf.sprintf "%s" id.name) + else None + | _ -> None ) + | Recursive bindings -> + Ext_list.find_opt bindings (fun (id, lam) -> + if not @@ Lam_analysis.no_side_effects lam then + Some (Printf.sprintf "%s" id.Ident.name) + else None) + | Nop lam -> + if not @@ Lam_analysis.no_side_effects lam then + (* (Lam_util.string_of_lambda lam) *) + Some "" + else None + (* TODO :*)) -module E = Js_exp_make -module S = Js_stmt_make - -let get_cmj_case output_prefix : Ext_namespace.file_kind = - let little = - Ext_char.is_lower_case (Filename.basename output_prefix).[0] - in - match little, !Js_config.bs_suffix with - | true, true -> Little_bs - | true, false -> Little_js - | false, true -> Upper_bs - | false, false -> Upper_js - - -let compile_group (meta : Lam_stats.t) - (x : Lam_group.t) : Js_output.t = - match x with - (* - We need - - 2. [E.builtin_dot] for javascript builtin - 3. [E.mldot] - *) - (* ATTENTION: check {!Lam_compile_global} for consistency *) - (** Special handling for values in [Pervasives] *) - (* - we delegate [stdout, stderr, and stdin] into [caml_io] module, - the motivation is to help dead code eliminatiion, it's helpful - to make those parts pure (not a function call), then it can be removed - if unused - *) - - (* QUICK hack to make hello world example nicer, - Note the arity of [print_endline] is already analyzed before, - so it should be safe - *) - - | Single (kind, id, lam) -> - (* let lam = Optimizer.simplify_lets [] lam in *) - (* can not apply again, it's wrong USE it with care*) - (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda { continuation = Declare (kind, id); - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - - | Recursive id_lams -> - Lam_compile.compile_recursive_lets - { continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } - id_lams - | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda {continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - -;; - - (** Also need analyze its depenency is pure or not *) -let no_side_effects (rest : Lam_group.t list) : string option = - Ext_list.find_opt rest (fun x -> - match x with - | Single(kind,id,body) -> - begin - match kind with - | Strict | Variable -> - if not @@ Lam_analysis.no_side_effects body - then Some (Printf.sprintf "%s" id.name) - else None - | _ -> None - end - | Recursive bindings -> - Ext_list.find_opt bindings (fun (id,lam) -> - if not @@ Lam_analysis.no_side_effects lam - then Some (Printf.sprintf "%s" id.Ident.name ) - else None - ) - | Nop lam -> - if not @@ Lam_analysis.no_side_effects lam - then - (* (Lam_util.string_of_lambda lam) *) - Some "" - else None (* TODO :*)) - +let _d s lam = -let _d = fun s lam -> + lam - lam -let _j = Js_pass_debug.dump +let _j = Js_pass_debug.dump -(** Actually simplify_lets is kind of global optimization since it requires you to know whether - it's used or not -*) -let compile - (output_prefix : string) - (lam : Lambda.lambda) = - let export_idents = Translmod.get_export_identifiers() in - let export_ident_sets = Set_ident.of_list export_idents in +(* Actually simplify_lets is kind of global optimization since it requires you + to know whether it's used or not *) +let compile (output_prefix : string) (lam : Lambda.lambda) = + let export_idents = Translmod.get_export_identifiers () in + let export_ident_sets = Set_ident.of_list export_idents in (* To make toplevel happy - reentrant for js-demo *) - let () = - - Lam_compile_env.reset () ; - in - let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + let () = - - let lam = _d "initial" lam in - let lam = Lam_pass_deep_flatten.deep_flatten lam in - let lam = _d "flatten0" lam in - let meta : Lam_stats.t = - Lam_stats.make - ~export_idents - ~export_ident_sets in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - let lam = - lam - |> _d "flattern1" - |> Lam_pass_exits.simplify_exits + Lam_compile_env.reset () + in + let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + + let lam = _d "initial" lam in + let lam = Lam_pass_deep_flatten.deep_flatten lam in + let lam = _d "flatten0" lam in + let meta : Lam_stats.t = Lam_stats.make ~export_idents ~export_ident_sets in + let () = Lam_pass_collect.collect_info meta lam in + let lam = + let lam = + lam |> _d "flattern1" |> Lam_pass_exits.simplify_exits |> _d "simplyf_exits" - |> (fun lam -> Lam_pass_collect.collect_info meta lam; lam) - |> Lam_pass_remove_alias.simplify_alias meta - |> _d "simplify_alias" - |> Lam_pass_deep_flatten.deep_flatten - |> _d "flatten2" - in (* Inling happens*) - - let () = Lam_pass_collect.collect_info meta lam in - let lam = Lam_pass_remove_alias.simplify_alias meta lam in + |> (fun lam -> + Lam_pass_collect.collect_info meta lam; + lam) + |> Lam_pass_remove_alias.simplify_alias meta + |> _d "simplify_alias" |> Lam_pass_deep_flatten.deep_flatten + |> _d "flatten2" + in + + (* Inling happens*) + let () = Lam_pass_collect.collect_info meta lam in + let lam = Lam_pass_remove_alias.simplify_alias meta lam in let lam = Lam_pass_deep_flatten.deep_flatten lam in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - lam - |> _d "alpha_before" + let () = Lam_pass_collect.collect_info meta lam in + let lam = + lam |> _d "alpha_before" |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "alpha_after" - |> Lam_pass_exits.simplify_exits in + |> _d "alpha_after" |> Lam_pass_exits.simplify_exits + in let () = Lam_pass_collect.collect_info meta lam in - - lam - |> _d "simplify_alias_before" - |> Lam_pass_remove_alias.simplify_alias meta + lam |> _d "simplify_alias_before" + |> Lam_pass_remove_alias.simplify_alias meta |> _d "alpha_conversion" - |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "before-simplify_lets" + |> Lam_pass_alpha_conversion.alpha_conversion meta + |> _d "before-simplify_lets" (* we should investigate a better way to put different passes : )*) - |> Lam_pass_lets_dce.simplify_lets - + |> Lam_pass_lets_dce.simplify_lets |> _d "before-simplify-exits" - (* |> (fun lam -> Lam_pass_collect.collect_info meta lam - ; Lam_pass_remove_alias.simplify_alias meta lam) *) - (* |> Lam_group_pass.scc_pass - |> _d "scc" *) + (* |> (fun lam -> Lam_pass_collect.collect_info meta lam ; + Lam_pass_remove_alias.simplify_alias meta lam) *) + (* |> Lam_group_pass.scc_pass |> _d "scc" *) |> Lam_pass_exits.simplify_exits |> _d "simplify_lets" - + + in + + let ({ Lam_coercion.groups } as coerced_input), meta = + Lam_coercion.coerce_and_group_big_lambda meta lam in - let ({Lam_coercion.groups = groups } as coerced_input , meta) = - Lam_coercion.coerce_and_group_big_lambda meta lam - in - let maybe_pure = no_side_effects groups in - - let body = + + let body = Ext_list.map groups (fun group -> compile_group meta group) - |> Js_output.concat - |> Js_output.output_as_block + |> Js_output.concat |> Js_output.output_as_block in - + (* The file is not big at all compared with [cmo] *) - (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) - let meta_exports = meta.exports in - let export_set = Set_ident.of_list meta_exports in - let js : J.program = - { - exports = meta_exports ; - export_set; - block = body} - in - js - |> _j "initial" - |> Js_pass_flatten.program - |> _j "flattern" - |> Js_pass_tailcall_inline.tailcall_inline - |> _j "inline_and_shake" - |> Js_pass_flatten_and_mark_dead.program - |> _j "flatten_and_mark_dead" + (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) + let meta_exports = meta.exports in + let export_set = Set_ident.of_list meta_exports in + let js : J.program = { exports = meta_exports; export_set; block = body } in + js |> _j "initial" |> Js_pass_flatten.program |> _j "flattern" + |> Js_pass_tailcall_inline.tailcall_inline |> _j "inline_and_shake" + |> Js_pass_flatten_and_mark_dead.program |> _j "flatten_and_mark_dead" (* |> Js_inline_and_eliminate.inline_and_shake *) (* |> _j "inline_and_shake" *) - |> (fun js -> ignore @@ Js_pass_scope.program js ; js ) - |> Js_shake.shake_program - |> _j "shake" - |> ( fun (program: J.program) -> - let external_module_ids : Lam_module_ident.t list = - if !Js_config.all_module_aliases then [] - else - let x = Lam_compile_env.get_required_modules - may_required_modules - (Js_fold_basic.calculate_hard_dependencies program.block) in - if !Js_config.sort_imports then - Ext_list.sort_via_array x - (fun id1 id2 -> - Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2) - ) - else - x - in - Warnings.check_fatal (); - let effect = - Lam_stats_export.get_dependent_module_effect - meta maybe_pure external_module_ids in - let v : Js_cmj_format.t = - Lam_stats_export.export_to_cmj - meta - effect - coerced_input.export_map - (get_cmj_case output_prefix) + |> (fun js -> + ignore @@ Js_pass_scope.program js; + js) + |> Js_shake.shake_program |> _j "shake" + |> fun (program : J.program) -> + let external_module_ids : Lam_module_ident.t list = + if !Js_config.all_module_aliases then [] + else + let x = + Lam_compile_env.get_required_modules may_required_modules + (Js_fold_basic.calculate_hard_dependencies program.block) in - (if not @@ !Clflags.dont_write_files then - Js_cmj_format.to_file - ~check_exists:(not !Js_config.force_cmj) - (output_prefix ^ Literals.suffix_cmj) v); - {J.program = program ; side_effect = effect ; modules = external_module_ids } - ) -;; - -let (//) = Filename.concat - -let lambda_as_module - (lambda_output : J.deps_program) - (output_prefix : string) - : unit = - let basename = - Ext_namespace.change_ext_ns_suffix - (Filename.basename - output_prefix) - (if !Js_config.bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) + if !Js_config.sort_imports then + Ext_list.sort_via_array x (fun id1 id2 -> + Ext_string.compare + (Lam_module_ident.name id1) + (Lam_module_ident.name id2)) + else x + in + Warnings.check_fatal (); + let effect = + Lam_stats_export.get_dependent_module_effect meta maybe_pure + external_module_ids + in + let v : Js_cmj_format.t = + Lam_stats_export.export_to_cmj meta effect coerced_input.export_map + (get_leading_case output_prefix) in - let package_info = Js_packages_state.get_packages_info () in - if Js_packages_info.is_empty package_info && !Js_config.js_stdout then - Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout + if not @@ !Clflags.dont_write_files then + Js_cmj_format.to_file ~check_exists:(not !Js_config.force_cmj) + (output_prefix ^ Literals.suffix_cmj) + v; + { J.program; side_effect = effect; modules = external_module_ids } + + +let ( // ) = Filename.concat + +let lambda_as_module (lambda_output : J.deps_program) (output_prefix : string) : + unit = + let package_info = Js_current_package_info.get_packages_info () in + if Js_package_info.is_empty package_info && !Js_config.js_stdout then + Js_dump_program.dump_deps_program ~ext:".js" ~output_prefix NodeJS + lambda_output stdout else - Js_packages_info.iter package_info (fun {module_system; path = _path} -> - let output_chan chan = - Js_dump_program.dump_deps_program ~output_prefix - module_system - lambda_output - chan in - if not @@ !Clflags.dont_write_files then + Js_package_info.iter package_info + (fun { module_system; path = _path; extension } -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:(Filename.basename output_prefix) + ~ext:extension + in + let output_chan chan = + Js_dump_program.dump_deps_program ~output_prefix ~ext:extension + module_system lambda_output chan + in + if not @@ !Clflags.dont_write_files then Ext_pervasives.with_file_as_chan - (Lazy.force Ext_path.package_dir // - _path // - basename - (* #913 only generate little-case js file *) - ) output_chan ) - + ( Lazy.force Ext_path.package_dir + // _path // basename (* #913 only generate little-case js file *) ) + output_chan) -(* 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, - includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr} +(* 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, includes {!Pervasives.stdin, Pervasives.stdout, + Pervasives.stderr} - However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name -*) + However, use filename instead of {!Env.current_unit} is more honest, since + node-js module system is coupled with the file name *) end module Parse : sig @@ -292445,171 +291968,193 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** -`jsoo_refmt_main` is the JSOO compilation entry point for building BuckleScript + Refmt as one bundle. -This is usually the file you want to build for the full playground experience. -*) +(** `jsoo_refmt_main` is the JSOO compilation entry point for building + BuckleScript + Refmt as one bundle. This is usually the file you want to + build for the full playground experience. *) module Js = Jsoo_common.Js -let () = +let () = Bs_conditional_initial.setup_env (); Clflags.binary_annotations := false -let error_of_exn e = - match Location.error_of_exn e with - | Some (`Ok e) -> Some e - | Some `Already_displayed - | None -> None + +let error_of_exn e = + match Location.error_of_exn e with + | Some (`Ok e) -> Some e + | Some `Already_displayed | None -> None + type react_ppx_version = V2 | V3 -let implementation ?prefix ~use_super_errors ?(react_ppx_version=V3) impl str : Js.Unsafe.obj = +let implementation ?prefix ~use_super_errors ?(react_ppx_version = V3) impl str + : Js.Unsafe.obj = let modulename = "Test" in (* let env = !Toploop.toplevel_env in *) (* Compmisc.init_path false; *) (* let modulename = module_of_filename ppf sourcefile outputprefix in *) (* Env.set_unit_name modulename; *) - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in (* Question ?? *) + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + (* Question ?? *) (* let finalenv = ref Env.empty in *) let types_signature = ref [] in - if use_super_errors then begin + if use_super_errors then ( Misc.Color.setup (Some Always); - Lazy.force Super_main.setup ; - end; - - + Lazy.force Super_main.setup ); try - let code = match prefix with + let code = + match prefix with | None -> str - | Some(prefix) -> prefix ^ str in + | Some prefix -> prefix ^ str + in let ast = impl (Lexing.from_string code) in - let ast = match react_ppx_version with - | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast - | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast in - let ast = Bs_builtin_ppx.rewrite_implementation ast in - let typed_tree = - let (a,b,_,signature) = Typemod.type_implementation_more modulename modulename modulename env ast in + let ast = + match react_ppx_version with + | V2 -> Reactjs_jsx_ppx_v2.rewrite_implementation ast + | V3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast + in + let ast = Bs_builtin_ppx.rewrite_implementation ast in + let typed_tree = + let a, b, _, signature = + Typemod.type_implementation_more modulename modulename modulename env + ast + in (* finalenv := c ; *) types_signature := signature; - (a,b) in - typed_tree - |> Translmod.transl_implementation modulename - |> (* Printlambda.lambda ppf *) (fun - {Lambda.code = lam} - - -> - let buffer = Buffer.create 1000 in - let () = Js_dump_program.pp_deps_program - ~output_prefix:"" (* does not matter here *) - NodeJS - (Lam_compile_main.compile "" - lam) - (Ext_pp.from_buffer buffer) in - let v = Buffer.contents buffer in - Js.Unsafe.(obj [| "js_code", inject @@ Js.string v |]) ) - (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) - with - | e -> - begin match error_of_exn e with - | Some error -> - Location.report_error Format.err_formatter error; + (a, b) + in + typed_tree |> Translmod.transl_implementation modulename + |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam } -> + let buffer = Buffer.create 1000 in + let () = + Js_dump_program.pp_deps_program (* does not matter here *) + ~output_prefix:"" ~ext:".js" NodeJS + (Lam_compile_main.compile "" lam) + (Ext_pp.from_buffer buffer) + in + let v = Buffer.contents buffer in + Js.Unsafe.(obj [| ("js_code", inject @@ Js.string v) |]) + (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *) + with e -> ( + match error_of_exn e with + | Some error -> + Location.report_error Format.err_formatter error; Jsoo_common.mk_js_error error.loc error.msg - | None -> + | None -> ( let msg = Printexc.to_string e in match e with - | Refmt_api.Migrate_parsetree.Def.Migration_error (_,loc) - | Refmt_api.Reason_errors.Reason_error (_,loc) -> - Jsoo_common.mk_js_error loc msg - | _ -> - Js.Unsafe.(obj [| - "js_error_msg" , inject @@ Js.string msg; - "type" , inject @@ Js.string "error" - |]) - end + | Refmt_api.Migrate_parsetree.Def.Migration_error (_, loc) + | Refmt_api.Reason_errors.Reason_error (_, loc) -> + Jsoo_common.mk_js_error loc msg + | _ -> + let open Js.Unsafe in + obj + [| + ("js_error_msg", inject @@ Js.string msg); + ("type", inject @@ Js.string "error"); + |] ) ) let compile ~use_super_errors ?react_ppx_version impl = - implementation ~use_super_errors ?react_ppx_version impl + implementation ~use_super_errors ?react_ppx_version impl + let shake_compile ~prefix ~use_super_errors ?react_ppx_version impl = - implementation ~prefix ~use_super_errors ?react_ppx_version impl + implementation ~prefix ~use_super_errors ?react_ppx_version impl + let load_module cmi_path cmi_content cmj_name cmj_content = Js.create_file cmi_path cmi_content; Js_cmj_datasets.data_sets := - Map_string.add !Js_cmj_datasets.data_sets - cmj_name (lazy (Js_cmj_format.from_string cmj_content)) + Map_string.add !Js_cmj_datasets.data_sets cmj_name + (lazy (Js_cmj_format.from_string cmj_content)) -let export (field : string) v = - Js.Unsafe.set (Js.Unsafe.global) field v -;; + +let export (field : string) v = Js.Unsafe.set Js.Unsafe.global field v (* To add a directory to the load path *) -let dir_directory d = - Config.load_path := d :: !Config.load_path +let dir_directory d = Config.load_path := d :: !Config.load_path -let () = - dir_directory "/static/cmis" +let () = dir_directory "/static/cmis" + +module Converter = + Refmt_api.Migrate_parsetree.Convert + (Refmt_api.Migrate_parsetree.OCaml_404) + (Refmt_api.Migrate_parsetree.OCaml_406) -module Converter = Refmt_api.Migrate_parsetree.Convert(Refmt_api.Migrate_parsetree.OCaml_404)(Refmt_api.Migrate_parsetree.OCaml_406) +let reason_parse lexbuf = + Refmt_api.Reason_toolchain.RE.implementation lexbuf + |> Converter.copy_structure -let reason_parse lexbuf = - Refmt_api.Reason_toolchain.RE.implementation lexbuf |> Converter.copy_structure;; -let make_compiler ~name ~prefix impl= +let make_compiler ~name ~prefix impl = export name - (Js.Unsafe.(obj - [|"compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:false (Js.to_string code))); - "shake_compile", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (shake_compile impl ~use_super_errors:false ~prefix (Js.to_string code))); - "compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true (Js.to_string code))); - "compile_super_errors_ppx_v2", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V2 (Js.to_string code))); - "compile_super_errors_ppx_v3", - inject @@ - Js.wrap_meth_callback - (fun _ code -> - (compile impl ~use_super_errors:true ~react_ppx_version:V3 (Js.to_string code))); - "shake_compile_super_errors", - inject @@ - Js.wrap_meth_callback - (fun _ code -> (shake_compile impl ~use_super_errors:true ~prefix (Js.to_string code))); - "version", Js.Unsafe.inject (Js.string (match name with | "reason" -> Refmt_api.version | _ -> Bs_version.version)); - "load_module", - inject @@ - Js.wrap_meth_callback - (fun _ cmi_path cmi_content cmj_name cmj_content -> - let cmj_bytestring = Js.to_bytestring cmj_content in - (* HACK: force string tag to ASCII (9) to avoid - * UTF-8 encoding *) - Js.Unsafe.set cmj_bytestring "t" 9; - load_module cmi_path cmi_content (Js.to_string cmj_name) cmj_bytestring); - |])) - -let () = make_compiler ~name:"ocaml" ~prefix:"[@@@bs.config {no_export}]\n#1 \"repl.ml\"\n" Parse.implementation -let () = make_compiler ~name:"reason" ~prefix:"[@bs.config {no_export: no_export}];\n#1 \"repl.re\";\n" reason_parse + Js.Unsafe.( + obj + [| + ( "compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:false (Js.to_string code)) ); + ( "shake_compile", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:false ~prefix + (Js.to_string code)) ); + ( "compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true (Js.to_string code)) ); + ( "compile_super_errors_ppx_v2", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V2 + (Js.to_string code)) ); + ( "compile_super_errors_ppx_v3", + inject + @@ Js.wrap_meth_callback (fun _ code -> + compile impl ~use_super_errors:true ~react_ppx_version:V3 + (Js.to_string code)) ); + ( "shake_compile_super_errors", + inject + @@ Js.wrap_meth_callback (fun _ code -> + shake_compile impl ~use_super_errors:true ~prefix + (Js.to_string code)) ); + ( "version", + Js.Unsafe.inject + (Js.string + ( match name with + | "reason" -> Refmt_api.version + | _ -> Bs_version.version )) ); + ( "load_module", + inject + @@ Js.wrap_meth_callback + (fun _ cmi_path cmi_content cmj_name cmj_content -> + let cmj_bytestring = Js.to_bytestring cmj_content in + (* HACK: force string tag to ASCII (9) to avoid + * UTF-8 encoding *) + Js.Unsafe.set cmj_bytestring "t" 9; + load_module cmi_path cmi_content (Js.to_string cmj_name) + cmj_bytestring) ); + |]) + + +let () = + make_compiler ~name:"ocaml" + ~prefix:"[@@@bs.config {no_export}]\n#1 \"repl.ml\"\n" Parse.implementation + + +let () = + make_compiler ~name:"reason" + ~prefix:"[@bs.config {no_export: no_export}];\n#1 \"repl.re\";\n" + reason_parse (* local variables: *) -(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *) +(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene + driver.cmo" *) (* end: *) - end diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml.d b/lib/4.06.1/unstable/js_refmt_compiler.ml.d index 8cfbe01640..9c4811b52f 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml.d +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/unstable/js_refmt_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_datasets.ml ./core/js_cmj_datasets.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_refmt_main.ml ./main/jsoo_refmt_main.mli ./main/refmt_api.ml ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file +../lib/4.06.1/unstable/js_refmt_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_datasets.ml ./core/js_cmj_datasets.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_current_package_info.ml ./core/js_current_package_info.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_package_info.ml ./core/js_package_info.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_refmt_main.ml ./main/jsoo_refmt_main.mli ./main/refmt_api.ml ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file diff --git a/lib/4.06.1/unstable/native_ppx.ml b/lib/4.06.1/unstable/native_ppx.ml index 74d7e00e47..3df6616a8f 100644 --- a/lib/4.06.1/unstable/native_ppx.ml +++ b/lib/4.06.1/unstable/native_ppx.ml @@ -14106,7 +14106,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14124,96 +14124,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -14241,83 +14219,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -14337,7 +14279,7 @@ end module Bs_warnings : sig #1 "bs_warnings.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14355,29 +14297,27 @@ module Bs_warnings : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = - | Unsafe_poly_variant_type +type t = Unsafe_poly_variant_type val prerr_bs_ffi_warning : Location.t -> t -> unit +val warn_deprecated_bs_suffix_flag : unit -> unit -val warn_missing_primitive : Location.t -> string -> unit +val warn_missing_primitive : Location.t -> string -> unit -val warn_literal_overflow : Location.t -> unit +val warn_literal_overflow : Location.t -> unit -val error_unescaped_delimiter : - Location.t -> string -> unit +val error_unescaped_delimiter : Location.t -> string -> unit end = struct #1 "bs_warnings.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -14395,117 +14335,106 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - type t = | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) + (** for users write code like this: + {[ external f : [ `a of int ] -> string = "" ]} + Here users forget about `[@bs.string]` or `[@bs.int]` *) let to_string t = match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + let warning_formatter = Format.err_formatter -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) -let unimplemented_primitive = "Unimplemented primitive used:" -type error = +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error + | Unimplemented_primitive of string +exception Error of Location.t * error let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) - + Format.pp_print_flush warning_formatter () ) +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) +(** Note the standard way of reporting error in compiler: -(** - Note the standard way of reporting error in compiler: - - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error - Define an error type + Define an error type - type error - exception Error of Location.t * error + type error exception Error of Location.t * error - Provide a printer to error + Provide a printer to error - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) end module Ext_util : sig @@ -15109,7 +15038,7 @@ end module Literals : sig #1 "literals.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15127,7 +15056,7 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15137,7 +15066,7 @@ module Literals : sig -val js_array_ctor : string +val js_array_ctor : string val js_type_number : string val js_type_string : string val js_type_object : string @@ -15150,9 +15079,9 @@ val partial_arg : string val prim : string (**temporary varaible used in {!Js_ast_util} *) -val tmp : string +val tmp : string -val create : string +val create : string val runtime : string val stdlib : string val imul : string @@ -15195,7 +15124,7 @@ val suffix_cmi : string val suffix_cmx : string val suffix_cmxa : string val suffix_ml : string -val suffix_mlast : string +val suffix_mlast : string val suffix_mlast_simple : string val suffix_mliast : string val suffix_reast : string @@ -15205,48 +15134,53 @@ val suffix_mliast_simple : string val suffix_mlmap : string val suffix_mll : string val suffix_re : string -val suffix_rei : string +val suffix_rei : string val suffix_d : string val suffix_js : string -val suffix_bs_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string (* val suffix_re_js : string *) -val suffix_gen_js : string +val suffix_gen_js : string val suffix_gen_tsx: string val suffix_tsx : string -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string -val commonjs : string +val commonjs : string -val es6 : string +val es6 : string val es6_global : string -val unused_attribute : string +val unused_attribute : string val dash_nostdlib : string -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string val native : string val bytecode : string val js : string -val node_sep : string -val node_parent : string -val node_current : string +val node_sep : string +val node_parent : string +val node_current : string val gentype_import : string val bsbuild_cache : string val sourcedirs_meta : string + end = struct #1 "literals.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -15264,7 +15198,7 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) @@ -15278,7 +15212,7 @@ end = struct let js_array_ctor = "Array" let js_type_number = "number" let js_type_string = "string" -let js_type_object = "object" +let js_type_object = "object" let js_type_boolean = "boolean" let js_undefined = "undefined" let js_prop_length = "length" @@ -15337,8 +15271,8 @@ let suffix_re = ".re" let suffix_rei = ".rei" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" let suffix_mlast = ".mlast" let suffix_mlast_simple = ".mlast_simple" let suffix_mliast = ".mliast" @@ -15346,19 +15280,24 @@ let suffix_reast = ".reast" let suffix_reiast = ".reiast" let suffix_mliast_simple = ".mliast_simple" let suffix_d = ".d" + let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" (* let suffix_re_js = ".re.js" *) let suffix_gen_js = ".gen.js" let suffix_gen_tsx = ".gen.tsx" let suffix_tsx = ".tsx" -let commonjs = "commonjs" +let commonjs = "commonjs" let es6 = "es6" let es6_global = "es6-global" -let unused_attribute = "Unused attribute " +let unused_attribute = "Unused attribute " let dash_nostdlib = "-nostdlib" let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" @@ -15377,9 +15316,10 @@ let node_current = "." let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let bsbuild_cache = ".bsbuild" let sourcedirs_meta = ".sourcedirs.json" + end module Ast_attributes : sig #1 "ast_attributes.mli" diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 5390c921d7..df3fcb9908 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -6992,7 +6992,7 @@ end module Js_config : sig #1 "js_config.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -7010,96 +7010,74 @@ module Js_config : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - -(* val get_packages_info : - unit -> Js_packages_info.t *) - - +val no_version_header : bool ref (** set/get header *) -val no_version_header : bool ref - - -(** return [package_name] and [path] - when in script mode: -*) -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) +(** return [package_name] and [path] when in script mode: *) +(* val get_current_package_name_and_path : Js_package_info.module_system -> + Js_package_info.info_query *) -(* val set_package_name : string -> unit -val get_package_name : unit -> string option *) +(* val set_package_name : string -> unit val get_package_name : unit -> string + option *) -(** cross module inline option *) val cross_module_inline : bool ref +(** cross module inline option *) + val set_cross_module_inline : bool -> unit val get_cross_module_inline : unit -> bool - + +val diagnose : bool ref (** diagnose option *) -val diagnose : bool ref -val get_diagnose : unit -> bool -val set_diagnose : bool -> unit +val get_diagnose : unit -> bool +val set_diagnose : bool -> unit +val no_builtin_ppx_ml : bool ref (** options for builtin ppx *) -val no_builtin_ppx_ml : bool ref -val no_builtin_ppx_mli : bool ref - +val no_builtin_ppx_mli : bool ref -val no_warn_unimplemented_external : bool ref +val no_warn_unimplemented_external : bool ref +val check_div_by_zero : bool ref (** check-div-by-zero option *) -val check_div_by_zero : bool ref -val get_check_div_by_zero : unit -> bool - - - - - - +val get_check_div_by_zero : unit -> bool val set_debug_file : string -> unit - -val is_same_file : unit -> bool +val is_same_file : unit -> bool val tool_name : string +val sort_imports : bool ref -val sort_imports : bool ref - -val syntax_only : bool ref +val syntax_only : bool ref val binary_ast : bool ref val simple_binary_ast : bool ref - -val bs_suffix : bool ref val debug : bool ref -val cmi_only : bool ref -val cmj_only : bool ref +val cmi_only : bool ref +val cmj_only : bool ref + (* stopped after generating cmj *) -val force_cmi : bool ref +val force_cmi : bool ref val force_cmj : bool ref val jsx_version : int ref val refmt : string option ref -val is_reason : bool ref +val is_reason : bool ref -val js_stdout : bool ref +val js_stdout : bool ref -val all_module_aliases : bool ref +val all_module_aliases : bool ref end = struct #1 "js_config.ml" @@ -7127,83 +7105,47 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - -(* let add_npm_package_path s = - match !packages_info with - | Empty -> - Ext_arg.bad_argf "please set package name first using -bs-package-name "; - | NonBrowser(name, envs) -> - let env, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ package_name; path] -> - (match Js_packages_info.module_system_of_string package_name with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" package_name), path - | [path] -> - NodeJS, path - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - packages_info := NonBrowser (name, ((env,path) :: envs)) *) -(** Browser is not set via command line only for internal use *) - - let no_version_header = ref false let cross_module_inline = ref false let get_cross_module_inline () = !cross_module_inline -let set_cross_module_inline b = - cross_module_inline := b - +let set_cross_module_inline b = cross_module_inline := b let diagnose = ref false let get_diagnose () = !diagnose let set_diagnose b = diagnose := b -let (//) = Filename.concat - -(* let get_packages_info () = !packages_info *) +let ( // ) = Filename.concat let no_builtin_ppx_ml = ref false let no_builtin_ppx_mli = ref false - (** TODO: will flip the option when it is ready *) -let no_warn_unimplemented_external = ref false +let no_warn_unimplemented_external = ref false let debug_file = ref "" +let set_debug_file f = debug_file := f -let set_debug_file f = debug_file := f - -let is_same_file () = - !debug_file <> "" && !debug_file = !Location.input_name +let is_same_file () = !debug_file <> "" && !debug_file = !Location.input_name let tool_name = "BuckleScript" let check_div_by_zero = ref true let get_check_div_by_zero () = !check_div_by_zero - - - let sort_imports = ref true let syntax_only = ref false let binary_ast = ref false let simple_binary_ast = ref false -let bs_suffix = ref false +let bs_suffix = ref false let debug = ref false -let cmi_only = ref false +let cmi_only = ref false let cmj_only = ref false let force_cmi = ref false @@ -61236,10 +61178,10 @@ let add_int_4 (b : t ) (x : int ) = end -module Literals : sig -#1 "literals.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +module Ext_namespace : sig +#1 "ext_namespace.mli" +(* Copyright (C) 2017- Authors of BuckleScript + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -61257,126 +61199,38 @@ module Literals : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val make : ?ns:string -> string -> string +(** [make ~ns:"Ns" "a"] A typical example would return "a-Ns" Note the namespace + comes from the output of [namespace_of_package_name] *) +val try_split_module_name : string -> (string * string) option +val replace_namespace_with_extension : name:string -> ext:string -> string +(** [replace_namespace_with_extension ~name ~ext] removes the part of [name] + after [ns_sep_char], if any; and appends [ext]. +*) +type leading_case = Upper | Lower +val js_filename_of_modulename : + name:string -> ext:string -> leading_case -> string +(** Predicts the JavaScript filename for a given (possibly namespaced) module- + name; i.e. [js_filename_of_modulename ~name:"AA-Ns" ~ext:".js" Lower] would + produce ["aA.bs.js"]. *) -val js_array_ctor : string -val js_type_number : string -val js_type_string : string -val js_type_object : string -val js_type_boolean : string -val js_undefined : string -val js_prop_length : string - -val param : string -val partial_arg : string -val prim : string - -(**temporary varaible used in {!Js_ast_util} *) -val tmp : string - -val create : string -val runtime : string -val stdlib : string -val imul : string - -val setter_suffix : string -val setter_suffix_len : int - - -val debugger : string - -val unsafe_downgrade : string -val fn_run : string -val method_run : string -val fn_method : string -val fn_mk : string - -(** callback actually, not exposed to user yet *) -(* val js_fn_runmethod : string *) - -val bs_deriving : string -val bs_deriving_dot : string -val bs_type : string - -(** nodejs *) - -val node_modules : string -val node_modules_length : int -val package_json : string -val bsconfig_json : string -val build_ninja : string - -(* Name of the library file created for each external dependency. *) -val library_file : string - -val suffix_a : string -val suffix_cmj : string -val suffix_cmo : string -val suffix_cma : string -val suffix_cmi : string -val suffix_cmx : string -val suffix_cmxa : string -val suffix_ml : string -val suffix_mlast : string -val suffix_mlast_simple : string -val suffix_mliast : string -val suffix_reast : string -val suffix_reiast : string - -val suffix_mliast_simple : string -val suffix_mlmap : string -val suffix_mll : string -val suffix_re : string -val suffix_rei : string - -val suffix_d : string -val suffix_js : string -val suffix_bs_js : string -(* val suffix_re_js : string *) -val suffix_gen_js : string -val suffix_gen_tsx: string - -val suffix_tsx : string - -val suffix_mli : string -val suffix_cmt : string -val suffix_cmti : string - -val commonjs : string - -val es6 : string -val es6_global : string - -val unused_attribute : string -val dash_nostdlib : string +val is_valid_npm_package_name : string -> bool -val reactjs_jsx_ppx_2_exe : string -val reactjs_jsx_ppx_3_exe : string - -val native : string -val bytecode : string -val js : string - -val node_sep : string -val node_parent : string -val node_current : string -val gentype_import : string - -val bsbuild_cache : string +val namespace_of_package_name : string -> string -val sourcedirs_meta : string end = struct -#1 "literals.ml" +#1 "ext_namespace.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -61394,333 +61248,121 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* Note the build system should check the validity of filenames espeically, it + should not contain '-' *) +let ns_sep_char = '-' +let ns_sep = "-" +let make ?ns cunit = + match ns with + | None -> cunit + | Some ns -> cunit ^ ns_sep ^ ns +(** Starting from the end, search for [ns_sep_char]. Returns the index, if + found, or [-1] if [ns_sep_char] is not found before reaching a + directory-separator. *) +let rec rindex_rec s i = + if i < 0 then i + else + let char = String.unsafe_get s i in + if Ext_filename.is_dir_sep char then -1 + else if char = ns_sep_char then i + else rindex_rec s (i - 1) +(* Note we have to output uncapitalized file Name, or at least be consistent, + since by reading cmi file on Case insensitive OS, we don't really know + whether it is `list.cmi` or `List.cmi`, so that `require(./list.js)` or + `require(./List.js)`. Relevant issues: #1609, #913 -let js_array_ctor = "Array" -let js_type_number = "number" -let js_type_string = "string" -let js_type_object = "object" -let js_type_boolean = "boolean" -let js_undefined = "undefined" -let js_prop_length = "length" + #1933 when removing ns suffix, don't pass the bound of basename -let prim = "prim" -let param = "param" -let partial_arg = "partial_arg" -let tmp = "tmp" + FIXME: micro-optimizaiton *) +let replace_namespace_with_extension ~name ~ext = + let i = rindex_rec name (String.length name - 1) in + if i < 0 then name ^ ext else String.sub name 0 i ^ ext -let create = "create" (* {!Caml_exceptions.create}*) - -let runtime = "runtime" (* runtime directory *) -let stdlib = "stdlib" +let try_split_module_name name = + let len = String.length name in + let i = rindex_rec name (len - 1) in + if i < 0 then None + else Some (String.sub name (i + 1) (len - i - 1), String.sub name 0 i) -let imul = "imul" (* signed int32 mul *) -let setter_suffix = "#=" -let setter_suffix_len = String.length setter_suffix +type leading_case = Upper | Lower -let debugger = "debugger" -let unsafe_downgrade = "unsafe_downgrade" -let fn_run = "fn_run" -let method_run = "method_run" +let js_filename_of_modulename ~name ~ext (leading_case : leading_case) = + match leading_case with + | Lower -> + replace_namespace_with_extension + ~name:(Ext_string.uncapitalize_ascii name) + ~ext + | Upper -> replace_namespace_with_extension ~name ~ext -let fn_method = "fn_method" -let fn_mk = "fn_mk" -(*let js_fn_runmethod = "js_fn_runmethod"*) -let bs_deriving = "bs.deriving" -let bs_deriving_dot = "bs.deriving." -let bs_type = "bs.type" +(** https://docs.npmjs.com/files/package.json + Some rules: -(** nodejs *) -let node_modules = "node_modules" -let node_modules_length = String.length "node_modules" -let package_json = "package.json" -let bsconfig_json = "bsconfig.json" -let build_ninja = "build.ninja" + - The name must be less than or equal to 214 characters. This includes the + scope for scoped packages. + - The name can't start with a dot or an underscore. + - New packages must not have uppercase letters in the name. + - The name ends up being part of a URL, an argument on the command line, and + a folder name. Therefore, the name can't contain any non-URL-safe + characters. -(* Name of the library file created for each external dependency. *) -let library_file = "lib" + TODO: handle cases like '\@angular/core'. its directory structure is like: -let suffix_a = ".a" -let suffix_cmj = ".cmj" -let suffix_cmo = ".cmo" -let suffix_cma = ".cma" -let suffix_cmi = ".cmi" -let suffix_cmx = ".cmx" -let suffix_cmxa = ".cmxa" -let suffix_mll = ".mll" -let suffix_ml = ".ml" -let suffix_mli = ".mli" -let suffix_re = ".re" -let suffix_rei = ".rei" -let suffix_mlmap = ".mlmap" - -let suffix_cmt = ".cmt" -let suffix_cmti = ".cmti" -let suffix_mlast = ".mlast" -let suffix_mlast_simple = ".mlast_simple" -let suffix_mliast = ".mliast" -let suffix_reast = ".reast" -let suffix_reiast = ".reiast" -let suffix_mliast_simple = ".mliast_simple" -let suffix_d = ".d" -let suffix_js = ".js" -let suffix_bs_js = ".bs.js" -(* let suffix_re_js = ".re.js" *) -let suffix_gen_js = ".gen.js" -let suffix_gen_tsx = ".gen.tsx" -let suffix_tsx = ".tsx" - -let commonjs = "commonjs" - -let es6 = "es6" -let es6_global = "es6-global" - -let unused_attribute = "Unused attribute " -let dash_nostdlib = "-nostdlib" - -let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" -let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" - -let native = "native" -let bytecode = "bytecode" -let js = "js" - - - -(** Used when produce node compatible paths *) -let node_sep = "/" -let node_parent = ".." -let node_current = "." + {[ + @angular + |-------- core + ]} *) +let is_valid_npm_package_name (s : string) = + let len = String.length s in + len <= 214 (* magic number forced by npm *) + && len > 0 + && + match String.unsafe_get s 0 with + | 'a' .. 'z' | '@' -> + Ext_string.for_all_from s 1 (fun x -> + match x with + | 'a' .. 'z' | '0' .. '9' | '_' | '-' -> true + | _ -> false) + | _ -> false -let gentype_import = "genType.import" -let bsbuild_cache = ".bsbuild" +let namespace_of_package_name (s : string) : string = + let len = String.length s in + let buf = Ext_buffer.create len in + let add capital ch = + Ext_buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch) + in + let rec aux capital off len = + if off >= len then () + else + let ch = String.unsafe_get s off in + match ch with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> + add capital ch; + aux false (off + 1) len + | '/' | '-' -> aux true (off + 1) len + | _ -> aux capital (off + 1) len + in + aux true 0 len; + Ext_buffer.contents buf -let sourcedirs_meta = ".sourcedirs.json" end -module Ext_namespace : sig -#1 "ext_namespace.mli" -(* Copyright (C) 2017- Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** [make ~ns:"Ns" "a" ] - A typical example would return "a-Ns" - Note the namespace comes from the output of [namespace_of_package_name] -*) -val make : - ?ns:string -> string -> string - -val try_split_module_name : - string -> (string * string ) option - - - -(* Note we have to output uncapitalized file Name, - or at least be consistent, since by reading cmi file on Case insensitive OS, we don't really know it is `list.cmi` or `List.cmi`, so that `require (./list.js)` or `require(./List.js)` - relevant issues: #1609, #913 - - #1933 when removing ns suffix, don't pass the bound - of basename -*) -val change_ext_ns_suffix : - string -> - string -> - string - -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - (** [js_name_of_modulename ~little A-Ns] - *) -val js_name_of_modulename : - string -> - file_kind -> - string - -(* TODO handle cases like - '@angular/core' - its directory structure is like - {[ - @angular - |-------- core - ]} -*) -val is_valid_npm_package_name : string -> bool - -val namespace_of_package_name : string -> string - -end = struct -#1 "ext_namespace.ml" - -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(* Note the build system should check the validity of filenames - espeically, it should not contain '-' -*) -let ns_sep_char = '-' -let ns_sep = "-" - -let make ?ns cunit = - match ns with - | None -> cunit - | Some ns -> cunit ^ ns_sep ^ ns - - -let rec rindex_rec s i = - if i < 0 then i else - let char = String.unsafe_get s i in - if Ext_filename.is_dir_sep char then -1 - else if char = ns_sep_char then i - else - rindex_rec s (i - 1) - -let change_ext_ns_suffix name ext = - let i = rindex_rec name (String.length name - 1) in - if i < 0 then name ^ ext - else String.sub name 0 i ^ ext (* FIXME: micro-optimizaiton*) - -let try_split_module_name name = - let len = String.length name in - let i = rindex_rec name (len - 1) in - if i < 0 then None - else - Some (String.sub name (i+1) (len - i - 1), - String.sub name 0 i ) -type file_kind = - | Upper_js - | Upper_bs - | Little_js - | Little_bs - - - -(* let js_name_of_basename bs_suffix s = - change_ext_ns_suffix s - (if bs_suffix then Literals.suffix_bs_js else Literals.suffix_js ) *) - -let js_name_of_modulename s little = - match little with - | Little_js -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_js - | Little_bs -> - change_ext_ns_suffix (Ext_string.uncapitalize_ascii s) Literals.suffix_bs_js - | Upper_js -> - change_ext_ns_suffix s Literals.suffix_js - | Upper_bs -> - change_ext_ns_suffix s Literals.suffix_bs_js - -(* https://docs.npmjs.com/files/package.json - Some rules: - The name must be less than or equal to 214 characters. This includes the scope for scoped packages. - The name can't start with a dot or an underscore. - New packages must not have uppercase letters in the name. - The name ends up being part of a URL, an argument on the command line, and a folder name. Therefore, the name can't contain any non-URL-safe characters. -*) -let is_valid_npm_package_name (s : string) = - let len = String.length s in - len <= 214 && (* magic number forced by npm *) - len > 0 && - match String.unsafe_get s 0 with - | 'a' .. 'z' | '@' -> - Ext_string.for_all_from s 1 - (fun x -> - match x with - | 'a'..'z' | '0'..'9' | '_' | '-' -> true - | _ -> false ) - | _ -> false - - -let namespace_of_package_name (s : string) : string = - let len = String.length s in - let buf = Ext_buffer.create len in - let add capital ch = - Ext_buffer.add_char buf - (if capital then - (Char.uppercase_ascii ch) - else ch) in - let rec aux capital off len = - if off >= len then () - else - let ch = String.unsafe_get s off in - match ch with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '_' - -> - add capital ch ; - aux false (off + 1) len - | '/' - | '-' -> - aux true (off + 1) len - | _ -> aux capital (off+1) len - in - aux true 0 len ; - Ext_buffer.contents buf - -end -module Outcome_printer_ns : sig -#1 "outcome_printer_ns.mli" -(* Copyright (C) 2017 Authors of BuckleScript +module Outcome_printer_ns : sig +#1 "outcome_printer_ns.mli" +(* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by @@ -63940,6 +63582,1007 @@ let write_file f content = output_string oc content end +end +module Ext_obj : sig +#1 "ext_obj.mli" +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val dump : 'a -> string +val pp_any : Format.formatter -> 'a -> unit +val bt : unit -> unit +end = struct +#1 "ext_obj.ml" +(* Copyright (C) 2019-Present Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + let rec dump r = + if Obj.is_int r then + string_of_int (Obj.magic r : int) + else (* Block. *) + let rec get_fields acc = function + | 0 -> acc + | n -> let n = n-1 in get_fields (Obj.field r n :: acc) n + in + let rec is_list r = + if Obj.is_int r then + r = Obj.repr 0 (* [] *) + else + let s = Obj.size r and t = Obj.tag r in + t = 0 && s = 2 && is_list (Obj.field r 1) (* h :: t *) + in + let rec get_list r = + if Obj.is_int r then + [] + else + let h = Obj.field r 0 and t = get_list (Obj.field r 1) in + h :: t + in + let opaque name = + (* XXX In future, print the address of value 'r'. Not possible + * in pure OCaml at the moment. *) + "<" ^ name ^ ">" + in + let s = Obj.size r and t = Obj.tag r in + (* From the tag, determine the type of block. *) + match t with + | _ when is_list r -> + let fields = get_list r in + "[" ^ String.concat "; " (Ext_list.map fields dump) ^ "]" + | 0 -> + let fields = get_fields [] s in + "(" ^ String.concat ", " (Ext_list.map fields dump) ^ ")" + | x when x = Obj.lazy_tag -> + (* Note that [lazy_tag .. forward_tag] are < no_scan_tag. Not + * clear if very large constructed values could have the same + * tag. XXX *) + opaque "lazy" + | x when x = Obj.closure_tag -> + opaque "closure" + | x when x = Obj.object_tag -> + let fields = get_fields [] s in + let _clasz, id, slots = + match fields with + | h::h'::t -> h, h', t + | _ -> assert false + in + (* No information on decoding the class (first field). So just print + * out the ID and the slots. *) + "Object #" ^ dump id ^ " (" ^ String.concat ", " (Ext_list.map slots dump) ^ ")" + | x when x = Obj.infix_tag -> + opaque "infix" + | x when x = Obj.forward_tag -> + opaque "forward" + | x when x < Obj.no_scan_tag -> + let fields = get_fields [] s in + "Tag" ^ string_of_int t ^ + " (" ^ String.concat ", " (Ext_list.map fields dump) ^ ")" + | x when x = Obj.string_tag -> + "\"" ^ String.escaped (Obj.magic r : string) ^ "\"" + | x when x = Obj.double_tag -> + string_of_float (Obj.magic r : float) + | x when x = Obj.abstract_tag -> + opaque "abstract" + | x when x = Obj.custom_tag -> + opaque "custom" + | x when x = Obj.custom_tag -> + opaque "final" + | x when x = Obj.double_array_tag -> + "[|"^ + String.concat ";" + (Array.to_list (Array.map string_of_float (Obj.magic r : float array))) ^ + "|]" + | _ -> + opaque (Printf.sprintf "unknown: tag %d size %d" t s) + +let dump v = dump (Obj.repr v) + +let pp_any fmt v = + Format.fprintf fmt "@[%s@]" + (dump v ) + + +let bt () = + let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace()) in + match raw_bt with + | None -> () + | Some raw_bt -> + let acc = ref [] in + (for i = Array.length raw_bt - 1 downto 0 do + let slot = raw_bt.(i) in + match Printexc.Slot.location slot with + | None + -> () + | Some bt -> + (match !acc with + | [] -> acc := [bt] + | hd::tl -> if hd <> bt then acc := bt :: !acc ) + + done); + Ext_list.iter !acc (fun bt -> + Printf.eprintf "File \"%s\", line %d, characters %d-%d\n" + bt.filename bt.line_number bt.start_char bt.end_char ) + +end +module Ext_arg : sig +#1 "ext_arg.mli" +val bad_argf : ('a, unit, string, 'b) format4 -> 'a + +end = struct +#1 "ext_arg.ml" +let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt +end +module Bs_warnings : sig +#1 "bs_warnings.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +type t = Unsafe_poly_variant_type + +val prerr_bs_ffi_warning : Location.t -> t -> unit + +val warn_deprecated_bs_suffix_flag : unit -> unit + +val warn_missing_primitive : Location.t -> string -> unit + +val warn_literal_overflow : Location.t -> unit + +val error_unescaped_delimiter : Location.t -> string -> unit + +end = struct +#1 "bs_warnings.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +type t = + | Unsafe_poly_variant_type + (** for users write code like this: + + {[ external f : [ `a of int ] -> string = "" ]} + + Here users forget about `[@bs.string]` or `[@bs.int]` *) + +let to_string t = + match t with + | Unsafe_poly_variant_type -> + "Here a OCaml polymorphic variant type passed into JS, probably you \ + forgot annotations like `[@bs.int]` or `[@bs.string]` " + + +let warning_formatter = Format.err_formatter + +let print_string_warning (loc : Location.t) ?(kind = "Warning") x = + if loc.loc_ghost then + Format.fprintf warning_formatter "File %s@." !Location.input_name + else Location.print warning_formatter loc; + Format.fprintf warning_formatter "@{%s@}: %s@." kind x + + +let prerr_bs_ffi_warning loc x = + Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) + + +let unimplemented_primitive = "Unimplemented primitive used:" +type error = + | Uninterpreted_delimiters of string + | Unimplemented_primitive of string +exception Error of Location.t * error + +let pp_error fmt x = + match x with + | Unimplemented_primitive str -> + Format.pp_print_string fmt unimplemented_primitive; + Format.pp_print_string fmt str + | Uninterpreted_delimiters str -> + Format.pp_print_string fmt "Uninterpreted delimiters"; + Format.pp_print_string fmt str + + +let () = + Location.register_error_of_exn (function + | Error (loc, err) -> Some (Location.error_of_printer loc pp_error err) + | _ -> None) + + +let warn_deprecated_bs_suffix_flag () = + if not !Clflags.bs_quiet then ( + print_string_warning Location.none ~kind:"DEPRECATED" + "`-bs-suffix` used; consider using third field of `-bs-package-output` \ + instead"; + Format.pp_print_flush warning_formatter () ) + + +let warn_missing_primitive loc txt = + if (not !Js_config.no_warn_unimplemented_external) && not !Clflags.bs_quiet + then ( + print_string_warning loc (unimplemented_primitive ^ txt ^ " \n"); + Format.pp_print_flush warning_formatter () ) + + +let warn_literal_overflow loc = + if not !Clflags.bs_quiet then ( + print_string_warning loc + "Integer literal exceeds the range of representable integers of type int"; + Format.pp_print_flush warning_formatter () ) + + +let error_unescaped_delimiter loc txt = + raise (Error (loc, Uninterpreted_delimiters txt)) + + +(** Note the standard way of reporting error in compiler: + + val Location.register_error_of_exn : (exn -> Location.error option) -> unit + val Location.error_of_printer : Location.t -> (Format.formatter -> error -> + unit) -> error -> Location.error + + Define an error type + + type error exception Error of Location.t * error + + Provide a printer to error + + {[ + let () = + Location.register_error_of_exn (function + | Error (loc, err) -> + Some (Location.error_of_printer loc pp_error err) + | _ -> None) + ]} *) + +end +module Literals : sig +#1 "literals.mli" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + +val js_array_ctor : string +val js_type_number : string +val js_type_string : string +val js_type_object : string +val js_type_boolean : string +val js_undefined : string +val js_prop_length : string + +val param : string +val partial_arg : string +val prim : string + +(**temporary varaible used in {!Js_ast_util} *) +val tmp : string + +val create : string +val runtime : string +val stdlib : string +val imul : string + +val setter_suffix : string +val setter_suffix_len : int + + +val debugger : string + +val unsafe_downgrade : string +val fn_run : string +val method_run : string +val fn_method : string +val fn_mk : string + +(** callback actually, not exposed to user yet *) +(* val js_fn_runmethod : string *) + +val bs_deriving : string +val bs_deriving_dot : string +val bs_type : string + +(** nodejs *) + +val node_modules : string +val node_modules_length : int +val package_json : string +val bsconfig_json : string +val build_ninja : string + +(* Name of the library file created for each external dependency. *) +val library_file : string + +val suffix_a : string +val suffix_cmj : string +val suffix_cmo : string +val suffix_cma : string +val suffix_cmi : string +val suffix_cmx : string +val suffix_cmxa : string +val suffix_ml : string +val suffix_mlast : string +val suffix_mlast_simple : string +val suffix_mliast : string +val suffix_reast : string +val suffix_reiast : string + +val suffix_mliast_simple : string +val suffix_mlmap : string +val suffix_mll : string +val suffix_re : string +val suffix_rei : string + +val suffix_d : string +val suffix_js : string +val suffix_mjs : string +val suffix_cjs : string +val suffix_bs_js : string +val suffix_bs_mjs : string +val suffix_bs_cjs : string +(* val suffix_re_js : string *) +val suffix_gen_js : string +val suffix_gen_tsx: string + +val suffix_tsx : string + +val suffix_mli : string +val suffix_cmt : string +val suffix_cmti : string + +val commonjs : string + +val es6 : string +val es6_global : string + +val unused_attribute : string +val dash_nostdlib : string + +val reactjs_jsx_ppx_2_exe : string +val reactjs_jsx_ppx_3_exe : string + +val native : string +val bytecode : string +val js : string + +val node_sep : string +val node_parent : string +val node_current : string +val gentype_import : string + +val bsbuild_cache : string + +val sourcedirs_meta : string + +end = struct +#1 "literals.ml" +(* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + + + + + + +let js_array_ctor = "Array" +let js_type_number = "number" +let js_type_string = "string" +let js_type_object = "object" +let js_type_boolean = "boolean" +let js_undefined = "undefined" +let js_prop_length = "length" + +let prim = "prim" +let param = "param" +let partial_arg = "partial_arg" +let tmp = "tmp" + +let create = "create" (* {!Caml_exceptions.create}*) + +let runtime = "runtime" (* runtime directory *) + +let stdlib = "stdlib" + +let imul = "imul" (* signed int32 mul *) + +let setter_suffix = "#=" +let setter_suffix_len = String.length setter_suffix + +let debugger = "debugger" +let unsafe_downgrade = "unsafe_downgrade" +let fn_run = "fn_run" +let method_run = "method_run" + +let fn_method = "fn_method" +let fn_mk = "fn_mk" +(*let js_fn_runmethod = "js_fn_runmethod"*) + +let bs_deriving = "bs.deriving" +let bs_deriving_dot = "bs.deriving." +let bs_type = "bs.type" + + +(** nodejs *) +let node_modules = "node_modules" +let node_modules_length = String.length "node_modules" +let package_json = "package.json" +let bsconfig_json = "bsconfig.json" +let build_ninja = "build.ninja" + +(* Name of the library file created for each external dependency. *) +let library_file = "lib" + +let suffix_a = ".a" +let suffix_cmj = ".cmj" +let suffix_cmo = ".cmo" +let suffix_cma = ".cma" +let suffix_cmi = ".cmi" +let suffix_cmx = ".cmx" +let suffix_cmxa = ".cmxa" +let suffix_mll = ".mll" +let suffix_ml = ".ml" +let suffix_mli = ".mli" +let suffix_re = ".re" +let suffix_rei = ".rei" +let suffix_mlmap = ".mlmap" + +let suffix_cmt = ".cmt" +let suffix_cmti = ".cmti" +let suffix_mlast = ".mlast" +let suffix_mlast_simple = ".mlast_simple" +let suffix_mliast = ".mliast" +let suffix_reast = ".reast" +let suffix_reiast = ".reiast" +let suffix_mliast_simple = ".mliast_simple" +let suffix_d = ".d" + +let suffix_js = ".js" +let suffix_mjs = ".mjs" +let suffix_cjs = ".cjs" +let suffix_bs_js = ".bs.js" +let suffix_bs_mjs = ".bs.mjs" +let suffix_bs_cjs = ".bs.cjs" +(* let suffix_re_js = ".re.js" *) +let suffix_gen_js = ".gen.js" +let suffix_gen_tsx = ".gen.tsx" +let suffix_tsx = ".tsx" + +let commonjs = "commonjs" + +let es6 = "es6" +let es6_global = "es6-global" + +let unused_attribute = "Unused attribute " +let dash_nostdlib = "-nostdlib" + +let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe" +let reactjs_jsx_ppx_3_exe = "reactjs_jsx_ppx_3.exe" + +let native = "native" +let bytecode = "bytecode" +let js = "js" + + + +(** Used when produce node compatible paths *) +let node_sep = "/" +let node_parent = ".." +let node_current = "." + +let gentype_import = "genType.import" + +let bsbuild_cache = ".bsbuild" + +let sourcedirs_meta = ".sourcedirs.json" + +end +module Js_package_info : sig +#1 "js_package_info.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +type module_system = NodeJS | Es6 | Es6_global + +val runtime_dir_of_module_system : module_system -> string + +val runtime_package_path : module_system -> string -> string + +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} + +type t + +val is_runtime_package : t -> bool + +val same_package_by_name : t -> t -> bool + +val iter : t -> (location_descriptor -> unit) -> unit + +val empty : t +val from_name : string -> t +val is_empty : t -> bool + +val dump_package_info : Format.formatter -> t -> unit + +val deprecated_set_bs_extension : unit -> unit + +val append_location_descriptor_of_string : t -> string -> t +(** used by command line option e.g [-bs-package-output commonjs:xx/path:ext] *) + +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} + +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +val get_output_dir : t -> package_dir:string -> module_system -> string + +(* Note here we compare the package info by order in theory, we can compare it + by set semantics *) +val query_package_location_by_module_system : t -> module_system -> query_result + +end = struct +#1 "js_package_info.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +[@@@ocaml.warning "+9"] + +type path = string + +type module_system = + | NodeJS + | Es6 + (* ignore node_modules, just calcluating relative path *) + | Es6_global + +(* ocamlopt could not optimize such simple case... *) +let compatible (dep : module_system) (query : module_system) = + match query with + | NodeJS -> dep = NodeJS + | Es6 -> dep = Es6 + (* As a dependency Leaf Node, it is the same either [global] or [not] *) + | Es6_global -> dep = Es6_global || dep = Es6 + + +type location_descriptor = { + module_system : module_system; + path : string; + extension : string; +} + +type package_name = Pkg_empty | Pkg_runtime | Pkg_normal of string + +let deprecated_use_bs_extension = ref false + +let runtime_package_name = "bs-platform" + +let ( // ) = Filename.concat + +(* in runtime lib, [es6] and [es6-global] are treated the same way *) +let runtime_dir_of_module_system (ms : module_system) = + match ms with + | NodeJS -> "js" + | Es6 | Es6_global -> "es6" + + +let runtime_package_path (ms : module_system) js_file = + runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file + + +type t = { name : package_name; locations : location_descriptor list } + +let same_package_by_name (x : t) (y : t) = x.name = y.name + +let is_runtime_package (x : t) = x.name = Pkg_runtime + +let iter (x : t) = Ext_list.iter x.locations + +(* TODO: not allowing user to provide such specific package name For empty + package, [-bs-package-output] does not make sense it is only allowed to + generate commonjs file in the same directory *) +let empty : t = { name = Pkg_empty; locations = [] } + +let from_name (name : string) = + if name = runtime_package_name then { name = Pkg_runtime; locations = [] } + else { name = Pkg_normal name; locations = [] } + + +let is_empty (x : t) = x.name = Pkg_empty + +let string_of_module_system (ms : module_system) = + match ms with + | NodeJS -> "NodeJS" + | Es6 -> "Es6" + | Es6_global -> "Es6_global" + + +let module_system_of_string package_name : module_system option = + match package_name with + | "commonjs" -> Some NodeJS + | "es6" -> Some Es6 + | "es6-global" -> Some Es6_global + | _ -> None + + +let dump_location_descriptor (fmt : Format.formatter) + { module_system = ms; path; extension } = + Format.fprintf fmt "@[%s:@ %s:@ %s@]" + (string_of_module_system ms) + path extension + + +let dump_package_name fmt (x : package_name) = + match x with + | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" + | Pkg_normal s -> Format.pp_print_string fmt s + | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name + + +let dump_package_info (fmt : Format.formatter) ({ name; locations } : t) = + Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name + (Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) + dump_location_descriptor) + locations + + +type package_paths = { + rel_path : string; + pkg_rel_path : string; + extension : string; +} +type query_result = + | Package_script + | Package_not_found + | Package_found of package_paths + +(* Note that package-name has to be exactly the same as npm package name, + otherwise the path resolution will be wrong *) +let query_package_location_by_module_system ({ name; locations } : t) + (module_system : module_system) : query_result = + match name with + | Pkg_empty -> Package_script + | Pkg_normal name -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + | Pkg_runtime -> ( + match + Ext_list.find_first locations (fun k -> + compatible k.module_system module_system) + with + | Some { path = rel_path; extension; module_system = _ms } -> + let pkg_rel_path = runtime_package_name // rel_path in + Package_found { rel_path; pkg_rel_path; extension } + | None -> Package_not_found ) + + +let get_js_path (x : t) module_system = + match + Ext_list.find_first x.locations (fun k -> + compatible k.module_system module_system) + with + | Some k -> k.path + | None -> assert false + + +(* for a single pass compilation, [output_dir] can be cached *) +let get_output_dir (info : t) ~package_dir module_system = + Filename.concat package_dir (get_js_path info module_system) + + +let deprecated_set_bs_extension () = + Bs_warnings.warn_deprecated_bs_suffix_flag (); + deprecated_use_bs_extension := true + + +let deprecated_get_default_extension () = + if !deprecated_use_bs_extension then Literals.suffix_bs_js + else Literals.suffix_js + + +(* FIXME: The deprecated -bs-suffix will only affect -bs-package-output flags + passed *after* it. *) +let append_location_descriptor_of_string (packages_info : t) (s : string) : t = + let module_system, path, extension = + match Ext_string.split ~keep_empty:false s ':' with + | [ module_system; path; extension ] -> (module_system, path, extension) + (* Note that, for most users, the default values for [module_system] and + [extension] come not from here, but from [bsb], which always invokes this + with a fully-populated [-bs-package-output]. + + If you're changing the default, make sure both places match! *) + | [ module_system; path ] -> + (module_system, path, deprecated_get_default_extension ()) + | [ path ] -> ("NodeJS", path, deprecated_get_default_extension ()) + | _ -> Ext_arg.bad_argf "invalid value for -bs-package-output: %s" s + in + let module_system = + match module_system_of_string module_system with + | Some x -> x + | None -> + Ext_arg.bad_argf "invalid module system in -bs-package-output: %s" + module_system + in + { + packages_info with + locations = { module_system; path; extension } :: packages_info.locations; + } + +(* support es6 modules instead + + TODO: enrich ast to support import export + http://www.ecma-international.org/ecma-262/6.0/#sec-imports For every module, + we need [Ident.t] for accessing and [filename] for import, they are not + necessarily the same. + + Es6 modules is not the same with commonjs, we use commonjs currently (play + better with node) + + FIXME: the module order matters? *) + +end +module Js_current_package_info : sig +#1 "js_current_package_info.mli" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +val set_package_name : string -> unit + +val set_package_map : string -> unit + +val get_packages_info : unit -> Js_package_info.t + +val append_location_descriptor_of_string : string -> unit + +end = struct +#1 "js_current_package_info.ml" +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program 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 Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +let packages_info = ref Js_package_info.empty + +let set_package_name name = + if Js_package_info.is_empty !packages_info then + packages_info := Js_package_info.from_name name + else Ext_arg.bad_argf "duplicated flag for -bs-package-name" + + +let set_package_map module_name = + Clflags.dont_record_crc_unit := Some module_name; + Clflags.open_modules := module_name :: !Clflags.open_modules + + +let append_location_descriptor_of_string s = + if Js_package_info.is_empty !packages_info then + Ext_arg.bad_argf "please set package name first using -bs-package-name or -bs-ns" + else + packages_info := Js_package_info.append_location_descriptor_of_string !packages_info s + +let get_packages_info () = !packages_info + end module Bs_exception : sig #1 "bs_exception.mli" @@ -83474,389 +84117,6 @@ let inline_int_primitive i : string list = (Ffi_inline_const (Lam_constant.Const_int32 (Int32.of_int i))) ] -end -module Ext_arg : sig -#1 "ext_arg.mli" -val bad_argf : ('a, unit, string, 'b) format4 -> 'a - -end = struct -#1 "ext_arg.ml" -let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt -end -module Js_packages_info : sig -#1 "js_packages_info.mli" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -type module_system = - | NodeJS - | Es6 - | Es6_global - - -val runtime_dir_of_module_system : - module_system -> - string - -val runtime_package_path: - module_system -> - string -> - string - -type package_info - = - { - module_system : module_system ; - path : string - } - -type t - -val is_runtime_package: - t -> - bool - -val same_package_by_name : - t -> - t -> - bool - -val iter : - t -> - (package_info -> unit) -> - unit - -val empty : t -val from_name : string -> t -val is_empty : t -> bool - -val dump_packages_info : - Format.formatter -> t -> unit - - -(** used by command line option - e.g [-bs-package-output commonjs:xx/path] -*) -val add_npm_package_path : - t -> - string -> - t - -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } - -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -val get_output_dir: - t -> - package_dir:string -> - module_system -> - string - -val query_package_infos: - t -> - module_system -> - info_query -(** Note here we compare the package info by order - in theory, we can compare it by set semantics -*) - - - -end = struct -#1 "js_packages_info.ml" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -[@@@ocaml.warning "+9"] - -type path = string - -type module_system = - | NodeJS - | Es6 - | Es6_global (* ignore node_modules, just calcluating relative path *) - - -(* ocamlopt could not optimize such simple case..*) -let compatible (dep : module_system) - (query : module_system) = - match query with - | NodeJS -> dep = NodeJS - | Es6 -> dep = Es6 - | Es6_global - -> dep = Es6_global || dep = Es6 -(* As a dependency Leaf Node, it is the same either [global] or [not] *) - - -type package_info = - { module_system : module_system ; path : string } - -type package_name = - | Pkg_empty - | Pkg_runtime - | Pkg_normal of string - - - -let runtime_package_name = "bs-platform" - - -let (//) = Filename.concat - -(* in runtime lib, [es6] and [es6] are treated the same wway *) -let runtime_dir_of_module_system (ms : module_system ) = - match ms with - | NodeJS -> "js" - | Es6 | Es6_global -> "es6" - -let runtime_package_path - (ms : module_system) - js_file = - runtime_package_name // "lib" // runtime_dir_of_module_system ms // js_file - - -type t = - { - name : package_name ; - module_systems: package_info list - } - -let same_package_by_name (x : t) (y : t) = x.name = y.name - -let is_runtime_package (x : t) = - x.name = Pkg_runtime - -let iter (x : t) cb = - Ext_list.iter x.module_systems cb - -(* let equal (x : t) ({name; module_systems}) = - x.name = name && - Ext_list.for_all2_no_exn - x.module_systems module_systems - (fun (a0,a1) (b0,b1) -> a0 = b0 && a1 = b1) *) - -(* we don't want force people to use package *) - -(** - TODO: not allowing user to provide such specific package name - For empty package, [-bs-package-output] does not make sense - it is only allowed to generate commonjs file in the same directory -*) -let empty : t = - { name = Pkg_empty ; - module_systems = [] - } - -let from_name (name : string) = - if name = runtime_package_name then - { - name = Pkg_runtime ; module_systems = [] - } - else - { - name = Pkg_normal name ; - module_systems = [] - } - -let is_empty (x : t) = - x.name = Pkg_empty - - -let string_of_module_system (ms : module_system) = - match ms with - | NodeJS -> "NodeJS" - | Es6 -> "Es6" - | Es6_global -> "Es6_global" - - -let module_system_of_string package_name : module_system option = - match package_name with - | "commonjs" -> Some NodeJS - | "es6" -> Some Es6 - | "es6-global" -> Some Es6_global - | _ -> None - -let dump_package_info - (fmt : Format.formatter) - ({module_system = ms; path = name} : package_info) - = - Format.fprintf - fmt - "@[%s:@ %s@]" - (string_of_module_system ms) - name - -let dump_package_name fmt (x : package_name) = - match x with - | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" - | Pkg_normal s -> Format.pp_print_string fmt s - | Pkg_runtime -> Format.pp_print_string fmt runtime_package_name - -let dump_packages_info - (fmt : Format.formatter) - ({name ; module_systems = ls } : t) = - Format.fprintf fmt "@[%a;@ @[%a@]@]" - dump_package_name - name - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) - dump_package_info - ) ls - -type package_found_info = - { - - rel_path : string ; - pkg_rel_path : string - } -type info_query = - | Package_script - | Package_not_found - | Package_found of package_found_info - -(* Note that package-name has to be exactly the same as - npm package name, otherwise the path resolution will be wrong *) -let query_package_infos - ({name; module_systems } : t) - (module_system : module_system) : info_query = - match name with - | Pkg_empty -> - Package_script - | Pkg_normal name -> - (match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found) - | Pkg_runtime -> - match Ext_list.find_first module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> - let rel_path = k.path in - let pkg_rel_path = runtime_package_name // rel_path in - Package_found - { - rel_path ; - pkg_rel_path - } - | None -> Package_not_found - - - -let get_js_path - (x : t ) - module_system - = - match Ext_list.find_first x.module_systems (fun k -> - compatible k.module_system module_system) with - | Some k -> k.path - | None -> assert false - -(* for a single pass compilation, [output_dir] - can be cached -*) -let get_output_dir - (info: t ) - ~package_dir module_system - = - Filename.concat package_dir - (get_js_path info module_system) - - - - -let add_npm_package_path (packages_info : t) (s : string) : t = - if is_empty packages_info then - Ext_arg.bad_argf "please set package name first using -bs-package-name " - else - let module_system, path = - match Ext_string.split ~keep_empty:false s ':' with - | [ module_system; path] -> - (match module_system_of_string module_system with - | Some x -> x - | None -> - Ext_arg.bad_argf "invalid module system %s" module_system), path - | [path] -> - NodeJS, path - | module_system :: path -> - (match module_system_of_string module_system with - | Some x -> x - | None -> Ext_arg.bad_argf "invalid module system %s" module_system), (String.concat ":" path) - | _ -> - Ext_arg.bad_argf "invalid npm package path: %s" s - in - { packages_info with module_systems = {module_system; path}::packages_info.module_systems} - -(* support es6 modules instead - TODO: enrich ast to support import export - http://www.ecma-international.org/ecma-262/6.0/#sec-imports - For every module, we need [Ident.t] for accessing and [filename] for import, - they are not necessarily the same. - - Es6 modules is not the same with commonjs, we use commonjs currently - (play better with node) - - FIXME: the module order matters? -*) - - end module Lam_compat : sig #1 "lam_compat.mli" @@ -86688,7 +86948,7 @@ end module Js_cmj_format : sig #1 "js_cmj_format.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -86706,102 +86966,69 @@ module Js_cmj_format : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** Define intemediate format to be serialized for cross module optimization *) +(** In this module, currently only arity information is exported, + - Short term: constant literals are also exported + - Long term: Benefit? since Google Closure Compiler already did such huge + amount of work + TODO: simple expression, literal small function can be stored, but what + would happen if small function captures other environment, for example + {[ let f x = g x ]} + {[ let f = g ]} *) - - -(** Define intemediate format to be serialized for cross module optimization - *) - -(** In this module, - currently only arity information is exported, - - Short term: constant literals are also exported - - Long term: - Benefit? since Google Closure Compiler already did such huge amount of work - TODO: simple expression, literal small function can be stored, - but what would happen if small function captures other environment - for example - - {[ - let f = fun x -> g x - ]} - - {[ - let f = g - ]} -*) - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (* Either constant or closed functor *) + arity : arity; + persistent_closed_lambda : Lam.t option; + (* Either constant or closed functor *) } type effect = string option -type cmj_case = Ext_namespace.file_kind - -type t - +type t -val mk: - values: cmj_value Map_string.t -> - effect: effect -> - npm_package_path: Js_packages_info.t -> - cmj_case:cmj_case -> +val mk : + values:cmj_value Map_string.t -> + effect:effect -> + package_info:Js_package_info.t -> + leading_case:Ext_namespace.leading_case -> t -val query_by_name : - t -> - string -> - arity * Lam.t option +val query_by_name : t -> string -> arity * Lam.t option -val is_pure : - t -> bool +val is_pure : t -> bool -val get_npm_package_path : - t -> - Js_packages_info.t +val get_package_info : t -> Js_package_info.t -val get_cmj_case : - t -> - cmj_case +val get_leading_case : t -> Ext_namespace.leading_case val single_na : arity - - val from_file : string -> t -val from_file_with_digest : - string -> t * Digest.t +val from_file_with_digest : string -> t * Digest.t val from_string : string -> t -(* Note writing the file if its content is not chnaged -*) -val to_file : - string -> check_exists:bool -> t -> unit +(* Note writing the file if its content is not chnaged *) +val to_file : string -> check_exists:bool -> t -> unit + +val pp_cmj : t -> unit -val pp_cmj: t -> unit end = struct #1 "js_cmj_format.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -86819,233 +87046,204 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - [@@@ocaml.warning "+9"] - -type arity = - | Single of Lam_arity.t - | Submodule of Lam_arity.t array +type arity = Single of Lam_arity.t | Submodule of Lam_arity.t array (* TODO: add a magic number *) -type cmj_value = { - arity : arity ; - persistent_closed_lambda : Lam.t option ; - (** Either constant or closed functor *) -} +type cmj_value = { arity : arity; persistent_closed_lambda : Lam.t option } type effect = string option - +(* we don't force people to use package *) let single_na = Single Lam_arity.na -(** we don't force people to use package *) -type cmj_case = Ext_namespace.file_kind - -type keyed_cmj_values - = (string * cmj_value) array + +type keyed_cmj_values = (string * cmj_value) array type t = { - values : keyed_cmj_values ; + values : keyed_cmj_values; pure : bool; - npm_package_path : Js_packages_info.t ; - cmj_case : cmj_case; + package_info : Js_package_info.t; + leading_case : Ext_namespace.leading_case; } + let empty_values = [||] -let mk ~values ~effect ~npm_package_path ~cmj_case : t = + +let mk ~values ~effect ~package_info ~leading_case : t = { - values = Map_string.to_sorted_array values; - pure = effect = None ; - npm_package_path; - cmj_case + values = Map_string.to_sorted_array values; + pure = effect = None; + package_info; + leading_case; } -let cmj_magic_number = "BUCKLE20171012" -let cmj_magic_number_length = - String.length cmj_magic_number - +let cmj_magic_number = "BUCKLE20200410" +let cmj_magic_number_length = String.length cmj_magic_number let digest_length = 16 (*16 chars *) let verify_magic_in_beg ic = - let buffer = really_input_string ic cmj_magic_number_length in + let buffer = really_input_string ic cmj_magic_number_length in if buffer <> cmj_magic_number then - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ (* Serialization .. *) let from_file name : t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let _digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v + let ic = open_in_bin name in + verify_magic_in_beg ic; + let _digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + v + let from_file_with_digest name : t * Digest.t = - let ic = open_in_bin name in - verify_magic_in_beg ic ; - let digest = Digest.input ic in - let v : t = input_value ic in - close_in ic ; - v,digest - - -let from_string s : t = - let magic_number = String.sub s 0 cmj_magic_number_length in - if magic_number = cmj_magic_number then - Marshal.from_string s (digest_length + cmj_magic_number_length) - else - Ext_fmt.failwithf ~loc:__LOC__ - "cmj files have incompatible versions, please rebuilt using the new compiler : %s" - __LOC__ + let ic = open_in_bin name in + verify_magic_in_beg ic; + let digest = Digest.input ic in + let v : t = input_value ic in + close_in ic; + (v, digest) + + +let from_string s : t = + let magic_number = String.sub s 0 cmj_magic_number_length in + if magic_number = cmj_magic_number then + Marshal.from_string s (digest_length + cmj_magic_number_length) + else + Ext_fmt.failwithf ~loc:__LOC__ + "cmj files have incompatible versions, please rebuilt using the new \ + compiler : %s" + __LOC__ + let fixed_length = cmj_magic_number_length + digest_length -let rec for_sure_not_changed (name : string) (header : string) = - if Sys.file_exists name then - let ic = open_in_bin name in - let holder = - really_input_string ic fixed_length in - close_in ic; - holder = header - else false - -(* This may cause some build system always rebuild - maybe should not be turned on by default -*) -let to_file name ~check_exists (v : t) = - let s = Marshal.to_string v [] in - let cur_digest = Digest.string s in - let header = cmj_magic_number ^ cur_digest in - if not (check_exists && for_sure_not_changed name header) then - let oc = open_out_bin name in - output_string oc header; +let rec for_sure_not_changed (name : string) (header : string) = + if Sys.file_exists name then ( + let ic = open_in_bin name in + let holder = really_input_string ic fixed_length in + close_in ic; + holder = header ) + else false + + +(* This may cause some build system always rebuild maybe should not be turned on + by default *) +let to_file name ~check_exists (v : t) = + let s = Marshal.to_string v [] in + let cur_digest = Digest.string s in + let header = cmj_magic_number ^ cur_digest in + if not (check_exists && for_sure_not_changed name header) then ( + let oc = open_out_bin name in + output_string oc header; output_string oc s; - close_out oc - -let keyComp (a : string) (b,_) = - Map_string.compare_key a b - -let not_found = single_na, None -let get_result midVal = - let (_,cmj_value) = midVal in - cmj_value.arity, - if Js_config.get_cross_module_inline () then cmj_value.persistent_closed_lambda - else None - -let rec binarySearchAux arr lo hi (key : string) = - let mid = (lo + hi)/2 in - let midVal = Array.unsafe_get arr mid in - let c = keyComp key midVal in - if c = 0 then - get_result midVal - else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let loVal = (Array.unsafe_get arr lo) in - if fst loVal = key then get_result loVal - else not_found - else binarySearchAux arr lo mid key - else (* a[lo] =< a[mid] < key <= a[hi] *) - if lo = mid then - let hiVal = (Array.unsafe_get arr hi) in - if fst hiVal = key then get_result hiVal - else not_found + close_out oc ) + + +let keyComp (a : string) (b, _) = Map_string.compare_key a b + +let not_found = (single_na, None) +let get_result midVal = + let _, cmj_value = midVal in + ( cmj_value.arity, + if Js_config.get_cross_module_inline () then + cmj_value.persistent_closed_lambda + else None ) + + +let rec binarySearchAux arr lo hi (key : string) = + let mid = (lo + hi) / 2 in + let midVal = Array.unsafe_get arr mid in + let c = keyComp key midVal in + if c = 0 then get_result midVal + else if c < 0 then + (* a[lo] =< key < a[mid] <= a[hi] *) + if hi = mid then + let loVal = Array.unsafe_get arr lo in + if fst loVal = key then get_result loVal else not_found + else binarySearchAux arr lo mid key + else if (* a[lo] =< a[mid] < key <= a[hi] *) + lo = mid then + let hiVal = Array.unsafe_get arr hi in + if fst hiVal = key then get_result hiVal else not_found else binarySearchAux arr mid hi key -let binarySearch (sorted : keyed_cmj_values) (key : string) = - let len = Array.length sorted in + +let binarySearch (sorted : keyed_cmj_values) (key : string) = + let len = Array.length sorted in if len = 0 then not_found - else - let lo = Array.unsafe_get sorted 0 in - let c = keyComp key lo in + else + let lo = Array.unsafe_get sorted 0 in + let c = keyComp key lo in if c < 0 then not_found else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = keyComp key hi in - if c2 > 0 then not_found - else binarySearchAux sorted 0 (len - 1) key + let hi = Array.unsafe_get sorted (len - 1) in + let c2 = keyComp key hi in + if c2 > 0 then not_found else binarySearchAux sorted 0 (len - 1) key -(* FIXME: better error message when ocamldep - get self-cycle -*) -let query_by_name (cmj_table : t ) name = - let values = cmj_table.values in - binarySearch values name +(* FIXME: better error message when ocamldep get self-cycle *) +let query_by_name (cmj_table : t) name = + let values = cmj_table.values in + binarySearch values name -let is_pure (cmj_table : t ) = - cmj_table.pure -let get_npm_package_path (cmj_table : t) = - cmj_table.npm_package_path +let is_pure (cmj_table : t) = cmj_table.pure -let get_cmj_case (cmj_table : t) = - cmj_table.cmj_case +let get_package_info (cmj_table : t) = cmj_table.package_info +let get_leading_case (cmj_table : t) = cmj_table.leading_case (* start dumping *) -let f fmt = Printf.fprintf stdout fmt - -let pp_cmj_case (cmj_case : cmj_case) : unit = - match cmj_case with - | Little_js -> - f "case : little, .js \n" - | Little_bs -> - f "case : little, .bs.js \n" - | Upper_js -> - f "case: upper, .js \n" - | Upper_bs -> - f "case: upper, .bs.js \n" - -let pp_cmj - ({ values ; pure; npm_package_path ; cmj_case} : t) = - f "package info: %s\n" - (Format.asprintf "%a" Js_packages_info.dump_packages_info npm_package_path) - ; - pp_cmj_case cmj_case; - - f "effect: %s\n" - (if pure then "pure" else "not pure"); - Ext_array.iter values - (fun (k , {arity; persistent_closed_lambda}) -> - match arity with - | Single arity -> - f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); - (match persistent_closed_lambda with - | None -> - f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; +let f fmt = Printf.fprintf stdout fmt + +let pp_leading_case (leading_case : Ext_namespace.leading_case) : unit = + match leading_case with + | Upper -> f "case: upper\n" + | Lower -> f "case: lower\n" + + +let pp_cmj ({ values; pure; package_info; leading_case } : t) = + f "package info: %s\n" + (Format.asprintf "%a" Js_package_info.dump_package_info package_info); + pp_leading_case leading_case; + + f "effect: %s\n" (if pure then "pure" else "not pure"); + Ext_array.iter values (fun (k, { arity; persistent_closed_lambda }) -> + match arity with + | Single arity -> ( + f "%s: %s\n" k (Format.asprintf "%a" Lam_arity.print arity); + match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s\n" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end ) - | Submodule xs -> - (match persistent_closed_lambda with - | None -> f "%s: not saved\n" k - | Some lam -> - begin - f "%s: ======[start]\n" k ; + f "%s: ======[finish]\n" k ) + | Submodule xs -> + ( match persistent_closed_lambda with + | None -> f "%s: not saved\n" k + | Some lam -> + f "%s: ======[start]\n" k; f "%s" (Lam_print.lambda_to_string lam); - f "%s: ======[finish]\n" k - end - ); - Array.iteri - (fun i arity -> f "%s[%i] : %s \n" - k i - (Format.asprintf "%a" Lam_arity.print arity )) - xs - ) + f "%s: ======[finish]\n" k ); + Array.iteri + (fun i arity -> + f "%s[%i] : %s \n" k i + (Format.asprintf "%a" Lam_arity.print arity)) + xs) + end module Config_util : sig #1 "config_util.mli" @@ -87188,7 +87386,7 @@ val find_cmj_exn : end = struct #1 "js_cmj_load.ml" (* Copyright (C) Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -87206,32 +87404,24 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* strategy: - If not installed, use the distributed [cmj] files, - make sure that the distributed files are platform independent -*) +(* strategy: If not installed, use the distributed [cmj] files, make sure that + the distributed files are platform independent *) +type path = string +type cmj_load_info = { cmj_table : Js_cmj_format.t; cmj_path : path } -type path = string -type cmj_load_info = { - cmj_table : Js_cmj_format.t ; - cmj_path : path ; -} - -let find_cmj_exn file : cmj_load_info = +let find_cmj_exn file : cmj_load_info = match Config_util.find_opt file with - | Some f - -> - {cmj_path = f; cmj_table = Js_cmj_format.from_file f} - | None -> - (* ONLY read the stored cmj data in browser environment *) - Bs_exception.error (Cmj_not_found file) + | Some f -> { cmj_path = f; cmj_table = Js_cmj_format.from_file f } + | None -> + (* ONLY read the stored cmj data in browser environment *) + Bs_exception.error (Cmj_not_found file) end @@ -98374,7 +98564,7 @@ end module Lam_compile_env : sig #1 "lam_compile_env.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -98392,96 +98582,69 @@ module Lam_compile_env : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** Helper for global Ocaml module index into meaningful names *) - - - - +(** Helper for global Ocaml module index into meaningful names *) type ident_info = { name : string; arity : Js_cmj_format.arity; - closed_lambda : Lam.t option -} - - - + closed_lambda : Lam.t option; +} -val reset : unit -> unit +val reset : unit -> unit -(** - [add_js_module hint_name module_name] - Given a js module name and hint name, assign an id to it - we also bookkeep it as [External] dependency. +val add_js_module : External_ffi_types.module_bind_name -> string -> Ident.t +(** [add_js_module hint_name module_name] Given a js module name and hint name, + assign an id to it we also bookkeep it as [External] dependency. - Note the complexity lies in that we should consolidate all - same external dependencies into a single dependency. - - The strategy is that we first create a [Lam_module_ident.t] - and query it if already exists in [cache_tbl], if it already - exists, we discard the freshly made one, and use the cached one, - otherwise, use the freshly made one instead + Note the complexity lies in that we should consolidate all same external + dependencies into a single dependency. - Invariant: - any [id] as long as put in the [cached_tbl] should be always valid, -*) -val add_js_module : - External_ffi_types.module_bind_name -> string -> Ident.t + The strategy is that we first create a [Lam_module_ident.t] and query it if + already exists in [cache_tbl], if it already exists, we discard the freshly + made one, and use the cached one, otherwise, use the freshly made one + instead + Invariant: any [id] as long as put in the [cached_tbl] should be always + valid, *) -(* The other dependencies are captured by querying - either when [access] or when expansion, - however such dependency can be removed after inlining etc. +(* The other dependencies are captured by querying either when [access] or when + expansion, however such dependency can be removed after inlining etc. - When we register such compile time dependency we classified - it as - Visit (ml), Builtin(built in js), External() + When we register such compile time dependency we classified it as Visit (ml), + Builtin(built in js), External() - For external, we never remove, we only consider - remove dependency for Runtime and Visit, so - when compile OCaml to Javascript, we only need - pay attention to for those modules are actually used or not -*) -(** - [query_external_id_info id pos env found] - will raise if not found -*) -val query_external_id_info : - Ident.t -> - string -> - ident_info + For external, we never remove, we only consider remove dependency for Runtime + and Visit, so when compile OCaml to Javascript, we only need pay attention to + for those modules are actually used or not *) +val query_external_id_info : Ident.t -> string -> ident_info +(** [query_external_id_info id pos env found] will raise if not found *) val is_pure_module : Lam_module_ident.t -> bool +val get_package_path_from_cmj : + Lam_module_ident.t -> string * Js_package_info.t * Ext_namespace.leading_case -val get_package_path_from_cmj : - Lam_module_ident.t -> - (string * Js_packages_info.t * Js_cmj_format.cmj_case) - - +val get_required_modules : + Lam_module_ident.Hash_set.t -> + Lam_module_ident.Hash_set.t -> + Lam_module_ident.t list +(** The second argument is mostly from [runtime] modules -(* The second argument is mostly from [runtime] modules will change the input [hard_dependencies] - [get_required_modules extra hard_dependencies] - [extra] maybe removed if it is pure and not in [hard_dependencies] -*) -val get_required_modules : - Lam_module_ident.Hash_set.t -> - Lam_module_ident.Hash_set.t -> - Lam_module_ident.t list + + [get_required_modules extra hard_dependencies] - [extra] maybe removed if it + is pure and not in [hard_dependencies] *) end = struct #1 "lam_compile_env.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -98499,199 +98662,134 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - - - - - -module E = Js_exp_make +module E = Js_exp_make module S = Js_stmt_make - -type env_value = +type env_value = | Ml of Js_cmj_load.cmj_load_info - | Runtime of Js_cmj_load.cmj_load_info - (** - [Runtime (pure, path, cmj_format)] - A built in module probably from our runtime primitives, - so it does not have any [signature] - - *) - | External - (** Also a js file, but this belong to third party - *) - - - + | Runtime of Js_cmj_load.cmj_load_info + (** [Runtime (pure, path, cmj_format)] A built in module probably from our + runtime primitives, so it does not have any [signature] *) + | External (** Also a js file, but this belong to third party *) type ident_info = { name : string; - arity : Js_cmj_format.arity; - closed_lambda : Lam.t option + arity : Js_cmj_format.arity; + closed_lambda : Lam.t option; } -(* - refer: [Env.find_pers_struct] - [ find_in_path_uncap !load_path (name ^ ".cmi")] -*) +(* refer: [Env.find_pers_struct] [ find_in_path_uncap !load_path (name ^ + ".cmi")] *) +let cached_tbl : env_value Lam_module_ident.Hash.t = + Lam_module_ident.Hash.create 31 -let cached_tbl : env_value Lam_module_ident.Hash.t - = Lam_module_ident.Hash.create 31 -let (+>) = Lam_module_ident.Hash.add cached_tbl - +let ( +> ) = Lam_module_ident.Hash.add cached_tbl (* For each compilation we need reset to make it re-entrant *) -let reset () = +let reset () = Translmod.reset (); - Lam_module_ident.Hash.clear cached_tbl - - - - - -(** We should not provide "#moduleid" as output - since when we print it in the end, it will - be escaped quite ugly -*) -let add_js_module - (hint_name : External_ffi_types.module_bind_name) - (module_name : string) : Ident.t - = - let id = - Ident.create - (match hint_name with - | Phint_name hint_name -> - Ext_string.capitalize_ascii hint_name - (* make sure the module name is capitalized - TODO: maybe a warning if the user hint is not good - *) - | Phint_nothing -> - Ext_modulename.js_id_name_of_hint_name module_name - ) + Lam_module_ident.Hash.clear cached_tbl + + +(** We should not provide "#moduleid" as output since when we print it in the + end, it will be escaped quite ugly *) +let add_js_module (hint_name : External_ffi_types.module_bind_name) + (module_name : string) : Ident.t = + let id = + Ident.create + ( match hint_name with + | Phint_name hint_name -> Ext_string.capitalize_ascii hint_name + (* make sure the module name is capitalized TODO: maybe a warning if the + user hint is not good *) + | Phint_nothing -> Ext_modulename.js_id_name_of_hint_name module_name ) in - let lam_module_ident = - Lam_module_ident.of_external id module_name in - match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with + let lam_module_ident = Lam_module_ident.of_external id module_name in + match Lam_module_ident.Hash.find_key_opt cached_tbl lam_module_ident with | None -> - Lam_module_ident.Hash.add - cached_tbl - lam_module_ident - External; - id - | Some old_key -> - old_key.id - - - - + Lam_module_ident.Hash.add cached_tbl lam_module_ident External; + id + | Some old_key -> old_key.id let query_external_id_info (module_id : Ident.t) (name : string) : ident_info = - let oid = Lam_module_ident.of_ml module_id in - let cmj_table = - match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - let cmj_load_info = - Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in - oid +> Ml cmj_load_info ; - cmj_load_info.cmj_table - | Some (Ml { cmj_table } ) - -> cmj_table + let oid = Lam_module_ident.of_ml module_id in + let cmj_table = + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> + let cmj_load_info = + Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) + in + oid +> Ml cmj_load_info; + cmj_load_info.cmj_table + | Some (Ml { cmj_table }) -> cmj_table | Some (Runtime _) -> assert false - | Some External -> assert false in - let arity , closed_lambda = - Js_cmj_format.query_by_name cmj_table name + | Some External -> assert false in - { - name; - arity; - closed_lambda - (* TODO shall we cache the arity ?*) - } - - - - - - - + let arity, closed_lambda = Js_cmj_format.query_by_name cmj_table name in + { name; arity; closed_lambda (* TODO shall we cache the arity ?*) } +let get_package_path_from_cmj (id : Lam_module_ident.t) = + match Lam_module_ident.Hash.find_opt cached_tbl id with + | Some (Ml { cmj_table; cmj_path }) -> + ( cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) + | Some (External | Runtime _) -> + assert false + (* called by {!Js_name_of_module_id.string_of_module_id} can not be + External *) + | None -> ( + match id.kind with + | Runtime | External _ -> assert false + | Ml -> + let ({ Js_cmj_load.cmj_table } as cmj_load_info) = + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name id ^ Literals.suffix_cmj) + in + id +> Ml cmj_load_info; + ( cmj_load_info.cmj_path, + Js_cmj_format.get_package_info cmj_table, + Js_cmj_format.get_leading_case cmj_table ) ) -let get_package_path_from_cmj - ( id : Lam_module_ident.t) - = - match Lam_module_ident.Hash.find_opt cached_tbl id with - | Some (Ml {cmj_table ; cmj_path}) -> - (cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - | Some ( - External | - Runtime _ ) -> - assert false - (* called by {!Js_name_of_module_id.string_of_module_id} - can not be External - *) - | None -> - begin match id.kind with - | Runtime - | External _ -> assert false - | Ml -> - let ({Js_cmj_load.cmj_table} as cmj_load_info) = - Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in - id +> Ml cmj_load_info; - (cmj_load_info.cmj_path, - Js_cmj_format.get_npm_package_path cmj_table, - Js_cmj_format.get_cmj_case cmj_table ) - end - let add = Lam_module_ident.Hash_set.add - - (* Conservative interface *) -let is_pure_module (oid : Lam_module_ident.t) = - match oid.kind with - | Runtime -> true +let is_pure_module (oid : Lam_module_ident.t) = + match oid.kind with + | Runtime -> true | External _ -> false - | Ml -> - begin match Lam_module_ident.Hash.find_opt cached_tbl oid with - | None -> - begin - match Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) with - | cmj_load_info -> - oid +> Ml cmj_load_info ; - Js_cmj_format.is_pure cmj_load_info.cmj_table - | exception _ -> false - end - | Some (Ml{cmj_table}|Runtime {cmj_table}) -> - Js_cmj_format.is_pure cmj_table - | Some External -> false - end - + | Ml -> ( + match Lam_module_ident.Hash.find_opt cached_tbl oid with + | None -> ( + match + Js_cmj_load.find_cmj_exn + (Lam_module_ident.name oid ^ Literals.suffix_cmj) + with + | cmj_load_info -> + oid +> Ml cmj_load_info; + Js_cmj_format.is_pure cmj_load_info.cmj_table + | exception _ -> false ) + | Some (Ml { cmj_table } | Runtime { cmj_table }) -> + Js_cmj_format.is_pure cmj_table + | Some External -> false ) -let get_required_modules - extras - (hard_dependencies - : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list = - Lam_module_ident.Hash.iter cached_tbl (fun id _ -> - if not @@ is_pure_module id - then add hard_dependencies id); - Lam_module_ident.Hash_set.iter extras (fun id -> - (if not @@ is_pure_module id - then add hard_dependencies id : unit) - ); + +let get_required_modules extras + (hard_dependencies : Lam_module_ident.Hash_set.t) : Lam_module_ident.t list + = + Lam_module_ident.Hash.iter cached_tbl (fun id _ -> + if not @@ is_pure_module id then add hard_dependencies id); + Lam_module_ident.Hash_set.iter extras (fun id -> + (if not @@ is_pure_module id then add hard_dependencies id : unit)); Lam_module_ident.Hash_set.elements hard_dependencies end @@ -101527,6 +101625,7 @@ val imports : Ext_pp.t -> (Ident.t * string) list -> Ext_pp_scope.t + end = struct #1 "js_dump_import_export.ml" (* Copyright (C) 2017 Authors of BuckleScript @@ -101676,8 +101775,8 @@ let imports cxt f (modules : (Ident.t * string) list ) = outer_cxt end -module Js_packages_state : sig -#1 "js_packages_state.mli" +module Js_name_of_module_id : sig +#1 "js_name_of_module_id.mli" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -101702,19 +101801,20 @@ module Js_packages_state : sig * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val string_of_module_id : + Lam_module_ident.t -> + output_dir:string -> + ext:string -> + Js_package_info.module_system -> + string +(** generate the mdoule path so that it can be spliced here: + {[ var Xx = require "package/path/to/xx.js" ]} -val set_package_name : string -> unit - -val set_package_map : string -> unit - -val get_packages_info : - unit -> Js_packages_info.t + Note that it has to be consistent to how it is generated *) -val update_npm_package_path : - string -> unit end = struct -#1 "js_packages_state.ml" +#1 "js_name_of_module_id.ml" (* Copyright (C) 2017 Authors of BuckleScript * * This program is free software: you can redistribute it and/or modify @@ -101739,261 +101839,157 @@ end = struct * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(* "xx/lib/ocaml/js.cmj" Enhancement: This can be delegated to build system *) +let runtime_package_path : string Lazy.t = + lazy + (Filename.dirname + (Filename.dirname + (Filename.dirname + ( match Config_util.find_opt "js.cmj" with + | None -> assert false + | Some x -> x )))) -let packages_info = ref Js_packages_info.empty - - - -let set_package_name name = - if Js_packages_info.is_empty !packages_info then - packages_info := Js_packages_info.from_name name - else - Ext_arg.bad_argf "duplicated flag for -bs-package-name" - -let set_package_map module_name = - (* set_package_name name ; - let module_name = Ext_namespace.namespace_of_package_name name in *) - Clflags.dont_record_crc_unit := Some module_name; - Clflags.open_modules := - module_name:: - !Clflags.open_modules - -let update_npm_package_path s = - packages_info := - Js_packages_info.add_npm_package_path !packages_info s - -let get_packages_info () = !packages_info -end -module Js_name_of_module_id : sig -#1 "js_name_of_module_id.mli" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -(** - generate the mdoule path so that it can be spliced here: - {[ - var Xx = require("package/path/to/xx.js") - ]} - Note that it has to be consistent to how it is generated -*) - -val string_of_module_id : - Lam_module_ident.t -> - output_dir:string -> - Js_packages_info.module_system -> - string -end = struct -#1 "js_name_of_module_id.ml" -(* Copyright (C) 2017 Authors of BuckleScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* -let (=) (x : int) (y:float) = assert false -*) -(* "xx/lib/ocaml/js.cmj" - Enhancement: This can be delegated to build system -*) -let runtime_package_path : string Lazy.t = - lazy (Filename.dirname (Filename.dirname - (Filename.dirname - (match Config_util.find_opt "js.cmj" with - | None -> assert false - | Some x -> x)))) +let ( // ) = Filename.concat -let (//) = Filename.concat +let fix_path_for_windows : string -> string = + if Ext_sys.is_windows_or_cygwin then Ext_string.replace_backward_slash + else fun s -> s -let fix_path_for_windows : string -> string = - if Ext_sys.is_windows_or_cygwin then Ext_string.replace_backward_slash - else fun s -> s - - -let get_runtime_module_path - (dep_module_id : Lam_module_ident.t) - (current_package_info : Js_packages_info.t) - module_system = - let current_info_query = - Js_packages_info.query_package_infos current_package_info - module_system in - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name Little_js in - match current_info_query with +let get_runtime_module_path (dep_module_id : Lam_module_ident.t) + (current_package_info : Js_package_info.t) module_system = + let loc = + Js_package_info.query_package_location_by_module_system current_package_info + module_system + in + let js_file = + Ext_namespace.js_filename_of_modulename ~name:dep_module_id.id.name + ~ext:".js" Lower + in + match loc with | Package_not_found -> assert false - | Package_script -> - Js_packages_info.runtime_package_path module_system js_file - | Package_found pkg -> - let dep_path = - "lib" // Js_packages_info.runtime_dir_of_module_system module_system in - if Js_packages_info.is_runtime_package current_package_info then - Ext_path.node_rebase_file - ~from:pkg.rel_path - ~to_:dep_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - match module_system with - | NodeJS | Es6 -> - Js_packages_info.runtime_package_path module_system js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system ) - (Lazy.force runtime_package_path // dep_path // js_file) - + | Package_script -> Js_package_info.runtime_package_path module_system js_file + | Package_found pkg -> ( + let dep_path = + "lib" // Js_package_info.runtime_dir_of_module_system module_system + in + if Js_package_info.is_runtime_package current_package_info then + Ext_path.node_rebase_file ~from:pkg.rel_path ~to_:dep_path js_file + (* TODO: we assume that both [x] and [path] could only be relative path + which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + Js_package_info.runtime_package_path module_system js_file + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package path + calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + (Lazy.force runtime_package_path // dep_path // js_file) ) (* [output_dir] is decided by the command line argument *) -let string_of_module_id - (dep_module_id : Lam_module_ident.t) - ~(output_dir : string ) - (module_system : Js_packages_info.module_system) - : string = - let current_package_info = Js_packages_state.get_packages_info () in - fix_path_for_windows ( - match dep_module_id.kind with +let string_of_module_id (dep_module_id : Lam_module_ident.t) + ~(output_dir : string) ~(ext : string) + (module_system : Js_package_info.module_system) : string = + let current_package_info = Js_current_package_info.get_packages_info () in + fix_path_for_windows + ( match dep_module_id.kind with | External name -> name (* the literal string for external package *) - (** This may not be enough, - 1. For cross packages, we may need settle - down a single js package - 2. We may need es6 path for dead code elimination - But frankly, very few JS packages have no dependency, - so having plugin may sound not that bad - *) - | Runtime -> - get_runtime_module_path dep_module_id current_package_info module_system - | Ml -> - let current_info_query = - Js_packages_info.query_package_infos - current_package_info - module_system - in - match Lam_compile_env.get_package_path_from_cmj dep_module_id with - | (cmj_path, dep_package_info, little) -> - let js_file = Ext_namespace.js_name_of_modulename dep_module_id.id.name little in - let dep_info_query = - Js_packages_info.query_package_infos dep_package_info module_system - in - match dep_info_query, current_info_query with - | Package_not_found , _ -> - Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) - | Package_script , Package_found _ -> - Bs_exception.error (Dependency_script_module_dependent_not js_file) - | (Package_script | Package_found _ ), Package_not_found -> assert false - - | Package_found pkg, Package_script - -> - - pkg.pkg_rel_path // js_file - - - | Package_found dep_pkg, - Package_found cur_pkg -> - if Js_packages_info.same_package_by_name current_package_info dep_package_info then - Ext_path.node_rebase_file - ~from:cur_pkg.rel_path - ~to_:dep_pkg.rel_path - js_file - (** TODO: we assume that both [x] and [path] could only be relative path - which is guaranteed by [-bs-package-output] - *) - else - begin match module_system with - | NodeJS | Es6 -> + (* This may not be enough, + + + For cross packages, we may need settle down a single js package + We + may need es6 path for dead code elimination + + But frankly, very few JS packages have no dependency, so having plugin + may sound not that bad *) + | Runtime -> + get_runtime_module_path dep_module_id current_package_info module_system + | Ml -> ( + let query = Js_package_info.query_package_location_by_module_system in + let current_loc = query current_package_info module_system in + match Lam_compile_env.get_package_path_from_cmj dep_module_id with + | cmj_path, dep_package_info, case -> ( + let dep_loc = query dep_package_info module_system in + match (dep_loc, current_loc) with + | Package_not_found, _ -> + Bs_exception.error (Missing_ml_dependency dep_module_id.id.name) + | Package_script, Package_found _ -> + let js_file = + Ext_namespace.js_filename_of_modulename + (* FIXME: Unsure how to infer a useful file-extension here. *) + ~name:dep_module_id.id.name ~ext:"" case + in + Bs_exception.error + (Dependency_script_module_dependent_not js_file) + | (Package_script | Package_found _), Package_not_found -> + assert false + | Package_found dep_pkg, Package_script -> + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in dep_pkg.pkg_rel_path // js_file - (** Note we did a post-processing when working on Windows *) - | Es6_global - -> - (** lib/ocaml/xx.cmj -- - HACKING: FIXME - maybe we can caching relative package path calculation or employ package map *) - (* assert false *) - - begin - Ext_path.rel_normalized_absolute_path - ~from:( - Js_packages_info.get_output_dir - current_package_info - ~package_dir:(Lazy.force Ext_path.package_dir) - module_system - ) - ((Filename.dirname - (Filename.dirname (Filename.dirname cmj_path))) // dep_pkg.rel_path // js_file) - end - end - | Package_script, Package_script - -> - match Config_util.find_opt js_file with - | Some file -> - let basename = Filename.basename file in - let dirname = Filename.dirname file in - Ext_path.node_rebase_file - ~from:( - Ext_path.absolute_cwd_path - output_dir) - ~to_:( - Ext_path.absolute_cwd_path - - dirname) - basename - | None -> - Bs_exception.error (Js_not_found js_file)) + | Package_found dep_pkg, Package_found cur_pkg -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext:dep_pkg.extension case + in + if + Js_package_info.same_package_by_name current_package_info + dep_package_info + then + Ext_path.node_rebase_file ~from:cur_pkg.rel_path + ~to_:dep_pkg.rel_path js_file + (* TODO: we assume that both [x] and [path] could only be + relative path which is guaranteed by [-bs-package-output] *) + else + match module_system with + | NodeJS | Es6 -> + + dep_pkg.pkg_rel_path // js_file + + (* Note we did a post-processing when working on Windows *) + | Es6_global -> + (* lib/ocaml/xx.cmj -- + + HACKING: FIXME maybe we can caching relative package + path calculation or employ package map *) + (* assert false *) + Ext_path.rel_normalized_absolute_path + ~from: + (Js_package_info.get_output_dir current_package_info + ~package_dir:(Lazy.force Ext_path.package_dir) + module_system) + ( Filename.dirname + (Filename.dirname (Filename.dirname cmj_path)) + // dep_pkg.rel_path // js_file ) ) + | Package_script, Package_script -> ( + let js_file = + Ext_namespace.js_filename_of_modulename + ~name:dep_module_id.id.name ~ext case + in + match Config_util.find_opt js_file with + | Some file -> + let basename = Filename.basename file in + let dirname = Filename.dirname file in + Ext_path.node_rebase_file + ~from:(Ext_path.absolute_cwd_path output_dir) + ~to_:(Ext_path.absolute_cwd_path dirname) + basename + | None -> Bs_exception.error (Js_not_found js_file) ) ) ) ) - (* Override it in browser *) @@ -102002,7 +101998,7 @@ end module Js_dump_program : sig #1 "js_dump_program.mli" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -102020,35 +102016,34 @@ module Js_dump_program : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -(** only used for debugging purpose *) val dump_program : J.program -> out_channel -> unit - +(** only used for debugging purpose *) val pp_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - Ext_pp.t -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + Ext_pp.t -> unit - val dump_deps_program : output_prefix:string -> - Js_packages_info.module_system -> - J.deps_program -> - out_channel -> + ext:string -> + Js_package_info.module_system -> + J.deps_program -> + out_channel -> unit - + end = struct #1 "js_dump_program.ml" (* Copyright (C) 2017 Authors of BuckleScript - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -102066,133 +102061,99 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) module P = Ext_pp -module L = Js_dump_lit +module L = Js_dump_lit +let empty_explanation = + "/* This output is empty. Its source's type definitions, externals and/or \ + unused code got optimized away. */\n" +let program_is_empty (x : J.program) = + match x with + | { block = []; exports = []; export_set = _ } -> true + | _ -> false -let empty_explanation = - "/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */\n" -let program_is_empty (x : J.program) = - match x with - | { - block = []; - exports = []; - export_set = _ - } -> true - | _ -> false +let deps_program_is_empty (x : J.deps_program) = + match x with + | { modules = []; program; side_effect = None } -> program_is_empty program + | _ -> false -let deps_program_is_empty (x : J.deps_program) = - match x with - | { modules = []; - program ; - side_effect = None - } -> program_is_empty program - | _ -> false -let program f cxt ( x : J.program ) = +let program f cxt (x : J.program) = P.force_newline f; - let cxt = Js_dump.statement_list true cxt f x.block in + let cxt = Js_dump.statement_list true cxt f x.block in P.force_newline f; Js_dump_import_export.exports cxt f x.exports -let dump_program (x : J.program) oc = - ignore (program (P.from_channel oc) Ext_pp_scope.empty x ) - -let node_program ~output_dir f ( x : J.deps_program) = - P.string f L.strict_directive; - P.newline f ; - let cxt = - Js_dump_import_export.requires - L.require - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id - x - ~output_dir - NodeJS - )) - in - program f cxt x.program +let dump_program (x : J.program) oc = + ignore (program (P.from_channel oc) Ext_pp_scope.empty x) +let node_program ~output_dir ~ext f (x : J.deps_program) = + P.string f L.strict_directive; + P.newline f; + let cxt = + Js_dump_import_export.requires L.require Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext NodeJS + ))) + in + program f cxt x.program -let es6_program ~output_dir fmt f ( x : J.deps_program) = - let cxt = - Js_dump_import_export.imports - Ext_pp_scope.empty - f - (Ext_list.map x.modules - (fun x -> - Lam_module_ident.id x, - Js_name_of_module_id.string_of_module_id x ~output_dir - fmt - )) +let es6_program ~output_dir ~ext fmt f (x : J.deps_program) = + let cxt = + Js_dump_import_export.imports Ext_pp_scope.empty f + (Ext_list.map x.modules (fun x -> + ( Lam_module_ident.id x, + Js_name_of_module_id.string_of_module_id x ~output_dir ~ext fmt ))) in - let () = P.force_newline f in - let cxt = Js_dump.statement_list true cxt f x.program.block in - let () = P.force_newline f in + let () = P.force_newline f in + let cxt = Js_dump.statement_list true cxt f x.program.block in + let () = P.force_newline f in Js_dump_import_export.es6_export cxt f x.program.exports - (** Make sure github linguist happy + {[ require('Linguist') Linguist::FileBlob.new('jscomp/test/test_u.js').generated? - ]} -*) + ]} *) -let pp_deps_program - ~output_prefix - (kind : Js_packages_info.module_system ) - (program : J.deps_program) (f : Ext_pp.t) = - if not !Js_config.no_version_header then - begin - P.string f Bs_version.header; - P.newline f - end ; - if deps_program_is_empty program then - P.string f empty_explanation +let pp_deps_program ~output_prefix ~ext (kind : Js_package_info.module_system) + (program : J.deps_program) (f : Ext_pp.t) = + if not !Js_config.no_version_header then ( + P.string f Bs_version.header; + P.newline f ); + if deps_program_is_empty program then P.string f empty_explanation (* This is empty module, it won't be referred anywhere *) - else - let output_dir = Filename.dirname output_prefix in - begin - ignore (match kind with - | Es6 | Es6_global -> - es6_program ~output_dir kind f program - | NodeJS -> - node_program ~output_dir f program - ) ; - P.newline f ; - P.string f ( - match program.side_effect with - | None -> "/* No side effect */" - | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); - P.newline f; - P.flush f () - end - + else + let output_dir = Filename.dirname output_prefix in + ignore + ( match kind with + | Es6 | Es6_global -> es6_program ~output_dir ~ext kind f program + | NodeJS -> node_program ~output_dir ~ext f program ); + P.newline f; + P.string f + ( match program.side_effect with + | None -> "/* No side effect */" + | Some v -> Printf.sprintf "/* %s Not a pure module */" v ); + P.newline f; + P.flush f () -let dump_deps_program - ~output_prefix - kind - x - (oc : out_channel) = - pp_deps_program ~output_prefix kind x (P.from_channel oc) +let dump_deps_program ~output_prefix ~ext kind x (oc : out_channel) = + pp_deps_program ~output_prefix ~ext kind x (P.from_channel oc) end module Js_fold_basic : sig @@ -111078,180 +111039,6 @@ let assemble_obj_args (labels : External_arg_spec.t list) (args : J.expression ) , var_v -end -module Bs_warnings : sig -#1 "bs_warnings.mli" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - -type t = - | Unsafe_poly_variant_type - -val prerr_bs_ffi_warning : Location.t -> t -> unit - - -val warn_missing_primitive : Location.t -> string -> unit - -val warn_literal_overflow : Location.t -> unit - -val error_unescaped_delimiter : - Location.t -> string -> unit - -end = struct -#1 "bs_warnings.ml" -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program 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 Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - - -type t = - | Unsafe_poly_variant_type - (* for users write code like this: - {[ external f : [`a of int ] -> string = ""]} - Here users forget about `[@bs.string]` or `[@bs.int]` - *) - - - -let to_string t = - match t with - | Unsafe_poly_variant_type - -> - "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]` " - -let warning_formatter = Format.err_formatter - -let print_string_warning (loc : Location.t) x = - if loc.loc_ghost then - Format.fprintf warning_formatter "File %s@." !Location.input_name - else - Location.print warning_formatter loc ; - Format.fprintf warning_formatter "@{Warning@}: %s@." x - -let prerr_bs_ffi_warning loc x = - Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x)) - -let unimplemented_primitive = "Unimplemented primitive used:" -type error = - | Uninterpreted_delimiters of string - | Unimplemented_primitive of string -exception Error of Location.t * error - -let pp_error fmt x = - match x with - | Unimplemented_primitive str -> - Format.pp_print_string fmt unimplemented_primitive; - Format.pp_print_string fmt str - - | Uninterpreted_delimiters str -> - Format.pp_print_string fmt "Uninterpreted delimiters" ; - Format.pp_print_string fmt str - - - -let () = - Location.register_error_of_exn (function - | Error (loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - - - - -let warn_missing_primitive loc txt = - if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then - begin - print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" ); - Format.pp_print_flush warning_formatter () - end - -let warn_literal_overflow loc = - if not !Clflags.bs_quiet then - begin - print_string_warning loc - "Integer literal exceeds the range of representable integers of type int"; - Format.pp_print_flush warning_formatter () - end - - - -let error_unescaped_delimiter loc txt = - raise (Error(loc, Uninterpreted_delimiters txt)) - - - - - - -(** - Note the standard way of reporting error in compiler: - - val Location.register_error_of_exn : (exn -> Location.error option) -> unit - val Location.error_of_printer : Location.t -> - (Format.formatter -> error -> unit) -> error -> Location.error - - Define an error type - - type error - exception Error of Location.t * error - - Provide a printer to error - - {[ - let () = - Location.register_error_of_exn - (function - | Error(loc,err) -> - Some (Location.error_of_printer loc pp_error err) - | _ -> None - ) - ]} -*) - end module Js_of_lam_exception : sig #1 "js_of_lam_exception.mli" @@ -406368,7 +406155,7 @@ end module Lam_stats_export : sig #1 "lam_stats_export.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -406386,32 +406173,25 @@ module Lam_stats_export : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val get_dependent_module_effect : + Lam_stats.t -> string option -> Lam_module_ident.t list -> string option - - -val get_dependent_module_effect: - Lam_stats.t -> - string option -> - Lam_module_ident.t list -> - string option - -val export_to_cmj : +val export_to_cmj : Lam_stats.t -> Js_cmj_format.effect -> Lam.t Map_ident.t -> - Js_cmj_format.cmj_case -> + Ext_namespace.leading_case -> Js_cmj_format.t - end = struct #1 "lam_stats_export.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -406429,141 +406209,109 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +let pp = Format.fprintf - - - - -let pp = Format.fprintf (* we should exclude meaninglist names and do the convert as well *) - -(* let meaningless_names = ["*opt*"; "param";] *) - - +(* let meaningless_names = ["*opt*"; "param";] *) let single_na = Js_cmj_format.single_na -let values_of_export - (meta : Lam_stats.t) - (export_map : Lam.t Map_ident.t) - : Js_cmj_format.cmj_value Map_string.t - = - Ext_list.fold_left meta.exports Map_string.empty - (fun acc x -> - let arity : Js_cmj_format.arity = - match Hash_ident.find_opt meta.ident_tbl x with - | Some (FunctionId {arity ; _}) -> Single arity - | Some (ImmutableBlock(elems)) -> - (* FIXME: field name for dumping*) - Submodule(Ext_array.map elems (fun x -> - match x with - | NA -> Lam_arity.na - | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam) - ) - | Some _ - | None -> - begin match Map_ident.find_opt export_map x with - | Some (Lprim {primitive = Pmakeblock (_,_, Immutable); args }) -> - Submodule (Ext_array.of_list_map args (fun lam -> - Lam_arity_analysis.get_arity meta lam)) - | Some _ - | None -> single_na - end - in - let persistent_closed_lambda = - if not !Js_config.cross_module_inline then None - else match Map_ident.find_opt export_map x with - | Some lambda -> - if Lam_analysis.safe_to_inline lambda - (* when inlning a non function, we have to be very careful, - only truly immutable values can be inlined - *) - then - if Lam_inline_util.should_be_functor x.name lambda (* can also be submodule *) - then - if Lam_closure.is_closed lambda (* TODO: seriealize more*) - then Some lambda - else None - else - let lam_size = Lam_analysis.size lambda in - (* TODO: - 1. global need re-assocate when do the beta reduction - 2. [lambda_exports] is not precise - *) - let free_variables = - Lam_closure.free_variables Set_ident.empty Map_ident.empty lambda in - if lam_size < Lam_analysis.small_inline_size && - Map_ident.is_empty free_variables - then - begin - Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name ; - Some lambda - end - else None - else - None - | None -> None in - Map_string.add acc x.name Js_cmj_format.{arity ; persistent_closed_lambda } - ) +let values_of_export (meta : Lam_stats.t) (export_map : Lam.t Map_ident.t) : + Js_cmj_format.cmj_value Map_string.t = + Ext_list.fold_left meta.exports Map_string.empty (fun acc x -> + let arity : Js_cmj_format.arity = + match Hash_ident.find_opt meta.ident_tbl x with + | Some (FunctionId { arity; _ }) -> Single arity + | Some (ImmutableBlock elems) -> + (* FIXME: field name for dumping*) + Submodule + (Ext_array.map elems (fun x -> + match x with + | NA -> Lam_arity.na + | SimpleForm lam -> Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> ( + match Map_ident.find_opt export_map x with + | Some (Lprim { primitive = Pmakeblock (_, _, Immutable); args }) -> + Submodule + (Ext_array.of_list_map args (fun lam -> + Lam_arity_analysis.get_arity meta lam)) + | Some _ | None -> single_na ) + in + let persistent_closed_lambda = + if not !Js_config.cross_module_inline then None + else + match Map_ident.find_opt export_map x with + | Some lambda -> + if + Lam_analysis.safe_to_inline lambda + (* when inlning a non function, we have to be very careful, only + truly immutable values can be inlined *) + then + if + Lam_inline_util.should_be_functor x.name lambda + (* can also be submodule *) + then + if Lam_closure.is_closed lambda (* TODO: seriealize more*) + then Some lambda + else None + else + let lam_size = Lam_analysis.size lambda in + (* TODO: 1. global need re-assocate when do the beta reduction + 2. [lambda_exports] is not precise *) + let free_variables = + Lam_closure.free_variables Set_ident.empty Map_ident.empty + lambda + in + if + lam_size < Lam_analysis.small_inline_size + && Map_ident.is_empty free_variables + then ( + Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name; + Some lambda ) + else None + else None + | None -> None + in + Map_string.add acc x.name + Js_cmj_format.{ arity; persistent_closed_lambda }) -(* ATTENTION: all runtime modules, if it is not hard required, - it should be okay to not reference it -*) -let get_dependent_module_effect - (meta : Lam_stats.t) - (maybe_pure : string option) - (external_ids : Lam_module_ident.t list) = - if maybe_pure = None then - let non_pure_module = - Ext_list.find_first_not external_ids - Lam_compile_env.is_pure_module - in - Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) - else - maybe_pure +(* ATTENTION: all runtime modules, if it is not hard required, it should be okay + to not reference it *) +let get_dependent_module_effect (meta : Lam_stats.t) + (maybe_pure : string option) (external_ids : Lam_module_ident.t list) = + if maybe_pure = None then + let non_pure_module = + Ext_list.find_first_not external_ids Lam_compile_env.is_pure_module + in + Ext_option.map non_pure_module (fun x -> Lam_module_ident.name x) + else maybe_pure -(* Note that - [lambda_exports] is - lambda expression to be exported - for the js backend, we compile to js - for the inliner, we try to seriaize it -- - relies on other optimizations to make this happen - {[ - exports.Make = function () {.....} - ]} - TODO: check that we don't do this in browser environment -*) -let export_to_cmj - (meta : Lam_stats.t ) - effect - export_map - cmj_case - : Js_cmj_format.t = - let values = values_of_export meta export_map in - - Js_cmj_format.mk - ~values - ~effect - ~npm_package_path: (Js_packages_state.get_packages_info ()) - ~cmj_case - (* FIXME: make sure [-o] would not change its case - add test for ns/non-ns - *) - +(* Note that [lambda_exports] is lambda expression to be exported for the js + backend, we compile to js for the inliner, we try to seriaize it -- relies on + other optimizations to make this happen {[ exports.Make = function () {.....} + ]} TODO: check that we don't do this in browser environment *) +let export_to_cmj (meta : Lam_stats.t) effect export_map + (leading_case : Ext_namespace.leading_case) : Js_cmj_format.t = + let values = values_of_export meta export_map in + (* FIXME: make sure [-o] would not change its case *) + (* FIXME: add test for ns/non-ns *) + Js_cmj_format.mk ~values ~effect + ~package_info:(Js_current_package_info.get_packages_info ()) + ~leading_case end module Lam_compile_main : sig #1 "lam_compile_main.mli" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -406581,40 +406329,25 @@ module Lam_compile_main : sig * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +(** BuckleScript entry point in the OCaml compiler *) +val compile : string -> Lambda.lambda -> J.deps_program +(** Compile and register the hook of function to compile a lambda to JS IR + For toplevel, [filename] is [""] which is the same as {!Env.get_unit_name + ()} *) - - - - -(** BuckleScript entry point in the OCaml compiler *) - -(** Compile and register the hook of function to compile a lambda to JS IR - *) - -(** For toplevel, [filename] is [""] which is the same as - {!Env.get_unit_name ()} - *) -val compile : - string -> - Lambda.lambda -> - J.deps_program - -val lambda_as_module : - J.deps_program -> - string -> - unit +val lambda_as_module : J.deps_program -> string -> unit end = struct #1 "lam_compile_main.ml" (* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * + * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, either version 3 of the License, or @@ -406632,290 +406365,240 @@ end = struct * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. - * + * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +module E = Js_exp_make +module S = Js_stmt_make +let get_leading_case output_prefix : Ext_namespace.leading_case = + if Ext_char.is_lower_case (Filename.basename output_prefix).[0] then Lower + else Upper +let compile_group (meta : Lam_stats.t) (x : Lam_group.t) : Js_output.t = + match x with + (* We need: 1. [E.builtin_dot] for javascript builtin, 2. [E.mldot] *) + (* ATTENTION: check {!Lam_compile_global} for consistency *) + (* Special handling for values in [Pervasives] *) + (* we delegate [stdout, stderr, and stdin] into [caml_io] module, the + motivation is to help dead code eliminatiion, it's helpful to make those + parts pure (not a function call), then it can be removed if unused *) + + (* QUICK hack to make hello world example nicer, Note the arity of + [print_endline] is already analyzed before, so it should be safe *) + | Single (kind, id, lam) -> + (* let lam = Optimizer.simplify_lets [] lam in *) + (* can not apply again, it's wrong USE it with care *) + (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) + Lam_compile.compile_lambda + { + continuation = Declare (kind, id); + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam + | Recursive id_lams -> + Lam_compile.compile_recursive_lets + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + id_lams + | Nop lam -> + (* TODO: Side effect callls, log and see statistics *) + Lam_compile.compile_lambda + { + continuation = EffectCall Not_tail; + jmp_table = Lam_compile_context.empty_handler_map; + meta; + } + lam +(* Also need analyze its depenency is pure or not *) +let no_side_effects (rest : Lam_group.t list) : string option = + Ext_list.find_opt rest (fun x -> + match x with + | Single (kind, id, body) -> ( + match kind with + | Strict | Variable -> + if not @@ Lam_analysis.no_side_effects body then + Some (Printf.sprintf "%s" id.name) + else None + | _ -> None ) + | Recursive bindings -> + Ext_list.find_opt bindings (fun (id, lam) -> + if not @@ Lam_analysis.no_side_effects lam then + Some (Printf.sprintf "%s" id.Ident.name) + else None) + | Nop lam -> + if not @@ Lam_analysis.no_side_effects lam then + (* (Lam_util.string_of_lambda lam) *) + Some "" + else None + (* TODO :*)) -module E = Js_exp_make -module S = Js_stmt_make - -let get_cmj_case output_prefix : Ext_namespace.file_kind = - let little = - Ext_char.is_lower_case (Filename.basename output_prefix).[0] - in - match little, !Js_config.bs_suffix with - | true, true -> Little_bs - | true, false -> Little_js - | false, true -> Upper_bs - | false, false -> Upper_js - - -let compile_group (meta : Lam_stats.t) - (x : Lam_group.t) : Js_output.t = - match x with - (* - We need - - 2. [E.builtin_dot] for javascript builtin - 3. [E.mldot] - *) - (* ATTENTION: check {!Lam_compile_global} for consistency *) - (** Special handling for values in [Pervasives] *) - (* - we delegate [stdout, stderr, and stdin] into [caml_io] module, - the motivation is to help dead code eliminatiion, it's helpful - to make those parts pure (not a function call), then it can be removed - if unused - *) - - (* QUICK hack to make hello world example nicer, - Note the arity of [print_endline] is already analyzed before, - so it should be safe - *) - - | Single (kind, id, lam) -> - (* let lam = Optimizer.simplify_lets [] lam in *) - (* can not apply again, it's wrong USE it with care*) - (* ([Js_stmt_make.comment (Gen_of_env.query_type id env )], None) ++ *) - Lam_compile.compile_lambda { continuation = Declare (kind, id); - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - - | Recursive id_lams -> - Lam_compile.compile_recursive_lets - { continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } - id_lams - | Nop lam -> (* TODO: Side effect callls, log and see statistics *) - Lam_compile.compile_lambda {continuation = EffectCall Not_tail; - jmp_table = Lam_compile_context.empty_handler_map; - meta - } lam - -;; - - (** Also need analyze its depenency is pure or not *) -let no_side_effects (rest : Lam_group.t list) : string option = - Ext_list.find_opt rest (fun x -> - match x with - | Single(kind,id,body) -> - begin - match kind with - | Strict | Variable -> - if not @@ Lam_analysis.no_side_effects body - then Some (Printf.sprintf "%s" id.name) - else None - | _ -> None - end - | Recursive bindings -> - Ext_list.find_opt bindings (fun (id,lam) -> - if not @@ Lam_analysis.no_side_effects lam - then Some (Printf.sprintf "%s" id.Ident.name ) - else None - ) - | Nop lam -> - if not @@ Lam_analysis.no_side_effects lam - then - (* (Lam_util.string_of_lambda lam) *) - Some "" - else None (* TODO :*)) - +let _d s lam = -let _d = fun s lam -> + lam - lam -let _j = Js_pass_debug.dump +let _j = Js_pass_debug.dump -(** Actually simplify_lets is kind of global optimization since it requires you to know whether - it's used or not -*) -let compile - (output_prefix : string) - (lam : Lambda.lambda) = - let export_idents = Translmod.get_export_identifiers() in - let export_ident_sets = Set_ident.of_list export_idents in +(* Actually simplify_lets is kind of global optimization since it requires you + to know whether it's used or not *) +let compile (output_prefix : string) (lam : Lambda.lambda) = + let export_idents = Translmod.get_export_identifiers () in + let export_ident_sets = Set_ident.of_list export_idents in (* To make toplevel happy - reentrant for js-demo *) - let () = - - Lam_compile_env.reset () ; - in - let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + let () = - - let lam = _d "initial" lam in - let lam = Lam_pass_deep_flatten.deep_flatten lam in - let lam = _d "flatten0" lam in - let meta : Lam_stats.t = - Lam_stats.make - ~export_idents - ~export_ident_sets in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - let lam = - lam - |> _d "flattern1" - |> Lam_pass_exits.simplify_exits + Lam_compile_env.reset () + in + let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in + + let lam = _d "initial" lam in + let lam = Lam_pass_deep_flatten.deep_flatten lam in + let lam = _d "flatten0" lam in + let meta : Lam_stats.t = Lam_stats.make ~export_idents ~export_ident_sets in + let () = Lam_pass_collect.collect_info meta lam in + let lam = + let lam = + lam |> _d "flattern1" |> Lam_pass_exits.simplify_exits |> _d "simplyf_exits" - |> (fun lam -> Lam_pass_collect.collect_info meta lam; lam) - |> Lam_pass_remove_alias.simplify_alias meta - |> _d "simplify_alias" - |> Lam_pass_deep_flatten.deep_flatten - |> _d "flatten2" - in (* Inling happens*) - - let () = Lam_pass_collect.collect_info meta lam in - let lam = Lam_pass_remove_alias.simplify_alias meta lam in + |> (fun lam -> + Lam_pass_collect.collect_info meta lam; + lam) + |> Lam_pass_remove_alias.simplify_alias meta + |> _d "simplify_alias" |> Lam_pass_deep_flatten.deep_flatten + |> _d "flatten2" + in + + (* Inling happens*) + let () = Lam_pass_collect.collect_info meta lam in + let lam = Lam_pass_remove_alias.simplify_alias meta lam in let lam = Lam_pass_deep_flatten.deep_flatten lam in - let () = Lam_pass_collect.collect_info meta lam in - let lam = - lam - |> _d "alpha_before" + let () = Lam_pass_collect.collect_info meta lam in + let lam = + lam |> _d "alpha_before" |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "alpha_after" - |> Lam_pass_exits.simplify_exits in + |> _d "alpha_after" |> Lam_pass_exits.simplify_exits + in let () = Lam_pass_collect.collect_info meta lam in - - lam - |> _d "simplify_alias_before" - |> Lam_pass_remove_alias.simplify_alias meta + lam |> _d "simplify_alias_before" + |> Lam_pass_remove_alias.simplify_alias meta |> _d "alpha_conversion" - |> Lam_pass_alpha_conversion.alpha_conversion meta - |> _d "before-simplify_lets" + |> Lam_pass_alpha_conversion.alpha_conversion meta + |> _d "before-simplify_lets" (* we should investigate a better way to put different passes : )*) - |> Lam_pass_lets_dce.simplify_lets - + |> Lam_pass_lets_dce.simplify_lets |> _d "before-simplify-exits" - (* |> (fun lam -> Lam_pass_collect.collect_info meta lam - ; Lam_pass_remove_alias.simplify_alias meta lam) *) - (* |> Lam_group_pass.scc_pass - |> _d "scc" *) + (* |> (fun lam -> Lam_pass_collect.collect_info meta lam ; + Lam_pass_remove_alias.simplify_alias meta lam) *) + (* |> Lam_group_pass.scc_pass |> _d "scc" *) |> Lam_pass_exits.simplify_exits |> _d "simplify_lets" - + + in + + let ({ Lam_coercion.groups } as coerced_input), meta = + Lam_coercion.coerce_and_group_big_lambda meta lam in - let ({Lam_coercion.groups = groups } as coerced_input , meta) = - Lam_coercion.coerce_and_group_big_lambda meta lam - in - let maybe_pure = no_side_effects groups in - - let body = + + let body = Ext_list.map groups (fun group -> compile_group meta group) - |> Js_output.concat - |> Js_output.output_as_block + |> Js_output.concat |> Js_output.output_as_block in - + (* The file is not big at all compared with [cmo] *) - (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) - let meta_exports = meta.exports in - let export_set = Set_ident.of_list meta_exports in - let js : J.program = - { - exports = meta_exports ; - export_set; - block = body} - in - js - |> _j "initial" - |> Js_pass_flatten.program - |> _j "flattern" - |> Js_pass_tailcall_inline.tailcall_inline - |> _j "inline_and_shake" - |> Js_pass_flatten_and_mark_dead.program - |> _j "flatten_and_mark_dead" + (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj") js; *) + let meta_exports = meta.exports in + let export_set = Set_ident.of_list meta_exports in + let js : J.program = { exports = meta_exports; export_set; block = body } in + js |> _j "initial" |> Js_pass_flatten.program |> _j "flattern" + |> Js_pass_tailcall_inline.tailcall_inline |> _j "inline_and_shake" + |> Js_pass_flatten_and_mark_dead.program |> _j "flatten_and_mark_dead" (* |> Js_inline_and_eliminate.inline_and_shake *) (* |> _j "inline_and_shake" *) - |> (fun js -> ignore @@ Js_pass_scope.program js ; js ) - |> Js_shake.shake_program - |> _j "shake" - |> ( fun (program: J.program) -> - let external_module_ids : Lam_module_ident.t list = - if !Js_config.all_module_aliases then [] - else - let x = Lam_compile_env.get_required_modules - may_required_modules - (Js_fold_basic.calculate_hard_dependencies program.block) in - if !Js_config.sort_imports then - Ext_list.sort_via_array x - (fun id1 id2 -> - Ext_string.compare (Lam_module_ident.name id1) (Lam_module_ident.name id2) - ) - else - x - in - Warnings.check_fatal (); - let effect = - Lam_stats_export.get_dependent_module_effect - meta maybe_pure external_module_ids in - let v : Js_cmj_format.t = - Lam_stats_export.export_to_cmj - meta - effect - coerced_input.export_map - (get_cmj_case output_prefix) + |> (fun js -> + ignore @@ Js_pass_scope.program js; + js) + |> Js_shake.shake_program |> _j "shake" + |> fun (program : J.program) -> + let external_module_ids : Lam_module_ident.t list = + if !Js_config.all_module_aliases then [] + else + let x = + Lam_compile_env.get_required_modules may_required_modules + (Js_fold_basic.calculate_hard_dependencies program.block) in - (if not @@ !Clflags.dont_write_files then - Js_cmj_format.to_file - ~check_exists:(not !Js_config.force_cmj) - (output_prefix ^ Literals.suffix_cmj) v); - {J.program = program ; side_effect = effect ; modules = external_module_ids } - ) -;; - -let (//) = Filename.concat - -let lambda_as_module - (lambda_output : J.deps_program) - (output_prefix : string) - : unit = - let basename = - Ext_namespace.change_ext_ns_suffix - (Filename.basename - output_prefix) - (if !Js_config.bs_suffix then Literals.suffix_bs_js else Literals.suffix_js) + if !Js_config.sort_imports then + Ext_list.sort_via_array x (fun id1 id2 -> + Ext_string.compare + (Lam_module_ident.name id1) + (Lam_module_ident.name id2)) + else x + in + Warnings.check_fatal (); + let effect = + Lam_stats_export.get_dependent_module_effect meta maybe_pure + external_module_ids + in + let v : Js_cmj_format.t = + Lam_stats_export.export_to_cmj meta effect coerced_input.export_map + (get_leading_case output_prefix) in - let package_info = Js_packages_state.get_packages_info () in - if Js_packages_info.is_empty package_info && !Js_config.js_stdout then - Js_dump_program.dump_deps_program ~output_prefix NodeJS lambda_output stdout + if not @@ !Clflags.dont_write_files then + Js_cmj_format.to_file ~check_exists:(not !Js_config.force_cmj) + (output_prefix ^ Literals.suffix_cmj) + v; + { J.program; side_effect = effect; modules = external_module_ids } + + +let ( // ) = Filename.concat + +let lambda_as_module (lambda_output : J.deps_program) (output_prefix : string) : + unit = + let package_info = Js_current_package_info.get_packages_info () in + if Js_package_info.is_empty package_info && !Js_config.js_stdout then + Js_dump_program.dump_deps_program ~ext:".js" ~output_prefix NodeJS + lambda_output stdout else - Js_packages_info.iter package_info (fun {module_system; path = _path} -> - let output_chan chan = - Js_dump_program.dump_deps_program ~output_prefix - module_system - lambda_output - chan in - if not @@ !Clflags.dont_write_files then + Js_package_info.iter package_info + (fun { module_system; path = _path; extension } -> + let basename = + Ext_namespace.replace_namespace_with_extension + ~name:(Filename.basename output_prefix) + ~ext:extension + in + let output_chan chan = + Js_dump_program.dump_deps_program ~output_prefix ~ext:extension + module_system lambda_output chan + in + if not @@ !Clflags.dont_write_files then Ext_pervasives.with_file_as_chan - (Lazy.force Ext_path.package_dir // - _path // - basename - (* #913 only generate little-case js file *) - ) output_chan ) - + ( Lazy.force Ext_path.package_dir + // _path // basename (* #913 only generate little-case js file *) ) + output_chan) -(* 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, - includes {!Pervasives.stdin, Pervasives.stdout, Pervasives.stderr} +(* 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, includes {!Pervasives.stdin, Pervasives.stdout, + Pervasives.stderr} - However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name -*) + However, use filename instead of {!Env.current_unit} is more honest, since + node-js module system is coupled with the file name *) end module Ast_invariants : sig @@ -415996,94 +415679,75 @@ end = struct (* *) (***********************************************************************) -(* adapted by bucklescript from [driver/compile.ml] for convenience *) +(* adapted by bucklescript from [driver/compile.ml] for convenience *) open Format open Typedtree open Compenv - - let fprintf = Format.fprintf - - let print_if_pipe ppf flag printer arg = if !flag then fprintf ppf "%a@." printer arg; arg -let print_if ppf flag printer arg = - if !flag then fprintf ppf "%a@." printer arg - +let print_if ppf flag printer arg = if !flag then fprintf ppf "%a@." printer arg -let process_with_gentype filename = +let process_with_gentype filename = match !Clflags.bs_gentype with | None -> () - | Some cmd -> - let comm = (cmd ^ - " -bs-version " ^ Bs_version.version ^ - " -cmt-add " ^ - filename ^ - ( ":" ^ !Location.input_name)) in - if !Clflags.verbose then begin - prerr_string "+ "; - prerr_endline comm; - prerr_newline () - end ; - ignore - (Sys.command comm - ) + | Some cmd -> + let comm = + cmd ^ " -bs-version " ^ Bs_version.version ^ " -cmt-add " ^ filename + ^ ":" ^ !Location.input_name + in + if !Clflags.verbose then ( + prerr_string "+ "; + prerr_endline comm; + prerr_newline () ); + ignore (Sys.command comm) + -let after_parsing_sig ppf outputprefix ast = - if !Js_config.simple_binary_ast then begin - let oc = open_out_bin (outputprefix ^ Literals.suffix_mliast_simple) in +let after_parsing_sig ppf outputprefix ast = + if !Js_config.simple_binary_ast then ( + let oc = open_out_bin (outputprefix ^ Literals.suffix_mliast_simple) in Ml_binary.write_ast Mli !Location.input_name ast oc; - close_out oc ; - end; + close_out oc ); if !Js_config.binary_ast then - begin - Binary_ast.write_ast - Mli - ~sourcefile:!Location.input_name - ~output:(outputprefix ^ if !Js_config.is_reason then Literals.suffix_reiast else Literals.suffix_mliast) - (* to support relocate to another directory *) - ast - - end; - if !Js_config.syntax_only then - Warnings.check_fatal() - else - begin - let modulename = module_of_filename ppf !Location.input_name outputprefix in - Lam_compile_env.reset () ; - let initial_env = Compmisc.initial_env () in - Env.set_unit_name modulename; - - let tsg = Typemod.type_interface - !Location.input_name - initial_env ast in - if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; - let sg = tsg.sig_type in - if !Clflags.print_types then - Printtyp.wrap_printing_env initial_env (fun () -> - fprintf std_formatter "%a@." - Printtyp.signature (Typemod.simplify_signature sg)); - ignore (Includemod.signatures initial_env sg sg); - Typecore.force_delayed_checks (); - Warnings.check_fatal (); - if not !Clflags.print_types then begin - - let deprecated = Builtin_attributes.deprecated_of_sig ast in - let sg = - Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi") - in - Typemod.save_signature modulename tsg outputprefix !Location.input_name - initial_env sg ; - process_with_gentype (outputprefix ^ ".cmti"); - end - end - + Binary_ast.write_ast Mli ~sourcefile:!Location.input_name + ~output: + ( outputprefix + ^ + if !Js_config.is_reason then Literals.suffix_reiast + else Literals.suffix_mliast ) + (* to support relocate to another directory *) + ast; + if !Js_config.syntax_only then Warnings.check_fatal () + else + let modulename = module_of_filename ppf !Location.input_name outputprefix in + Lam_compile_env.reset (); + let initial_env = Compmisc.initial_env () in + Env.set_unit_name modulename; + + let tsg = Typemod.type_interface !Location.input_name initial_env ast in + if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg; + let sg = tsg.sig_type in + if !Clflags.print_types then + Printtyp.wrap_printing_env initial_env (fun () -> + fprintf std_formatter "%a@." Printtyp.signature + (Typemod.simplify_signature sg)); + ignore (Includemod.signatures initial_env sg sg); + Typecore.force_delayed_checks (); + Warnings.check_fatal (); + if not !Clflags.print_types then ( + let deprecated = Builtin_attributes.deprecated_of_sig ast in + let sg = + Env.save_signature ~deprecated sg modulename (outputprefix ^ ".cmi") + in + Typemod.save_signature modulename tsg outputprefix !Location.input_name + initial_env sg; + process_with_gentype (outputprefix ^ ".cmti") ) let interface ppf fname outputprefix = @@ -416091,136 +415755,125 @@ let interface ppf fname outputprefix = Pparse.parse_interface ~tool_name:Js_config.tool_name ppf fname |> Ppx_entry.rewrite_signature |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface - |> print_if_pipe ppf Clflags.dump_source Pprintast.signature - |> after_parsing_sig ppf outputprefix + |> print_if_pipe ppf Clflags.dump_source Pprintast.signature + |> after_parsing_sig ppf outputprefix + -let interface_mliast ppf fname outputprefix = +let interface_mliast ppf fname outputprefix = Compmisc.init_path false; - Binary_ast.read_ast Mli fname + Binary_ast.read_ast Mli fname |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface - |> print_if_pipe ppf Clflags.dump_source Pprintast.signature - |> after_parsing_sig ppf outputprefix - -let all_module_alias (ast : Parsetree.structure)= - Ext_list.for_all ast (fun {pstr_desc} -> - match pstr_desc with - | Pstr_module {pmb_expr = {pmod_desc = Pmod_ident _ }} - -> true - | Pstr_attribute _ -> true - | Pstr_eval _ - | Pstr_value _ - | Pstr_primitive _ - | Pstr_type _ - | Pstr_typext _ - | Pstr_exception _ - | Pstr_module _ - | Pstr_recmodule _ - | Pstr_modtype _ - | Pstr_open _ - | Pstr_class _ - | Pstr_class_type _ - | Pstr_include _ - | Pstr_extension _ -> false - ) - -let after_parsing_impl ppf outputprefix ast = - Js_config.all_module_aliases := - !Clflags.assume_no_mli = Mli_non_exists && - all_module_alias ast - ; - if !Js_config.simple_binary_ast then begin - let oc = open_out_bin (outputprefix ^ Literals.suffix_mlast_simple) in - Ml_binary.write_ast Ml !Location.input_name ast oc; - close_out oc ; - end; + |> print_if_pipe ppf Clflags.dump_source Pprintast.signature + |> after_parsing_sig ppf outputprefix + + +let all_module_alias (ast : Parsetree.structure) = + Ext_list.for_all ast (fun { pstr_desc } -> + match pstr_desc with + | Pstr_module { pmb_expr = { pmod_desc = Pmod_ident _ } } -> true + | Pstr_attribute _ -> true + | Pstr_eval _ + | Pstr_value _ + | Pstr_primitive _ + | Pstr_type _ + | Pstr_typext _ + | Pstr_exception _ + | Pstr_module _ + | Pstr_recmodule _ + | Pstr_modtype _ + | Pstr_open _ + | Pstr_class _ + | Pstr_class_type _ + | Pstr_include _ + | Pstr_extension _ -> false) + + +let after_parsing_impl ppf outputprefix ast = + Js_config.all_module_aliases := + !Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast; + if !Js_config.simple_binary_ast then ( + let oc = open_out_bin (outputprefix ^ Literals.suffix_mlast_simple) in + Ml_binary.write_ast Ml !Location.input_name ast oc; + close_out oc ); if !Js_config.binary_ast then - Binary_ast.write_ast ~sourcefile:!Location.input_name - Ml ~output:(outputprefix ^ - if !Js_config.is_reason then Literals.suffix_reast else Literals.suffix_mlast - ) - ast ; - if !Js_config.syntax_only then - Warnings.check_fatal () - else - begin - let modulename = Ext_filename.module_name outputprefix in - Lam_compile_env.reset () ; - let env = Compmisc.initial_env() in - Env.set_unit_name modulename; - let (typedtree, coercion, _, _) = - Typemod.type_implementation_more - ?check_exists:(if !Js_config.force_cmi then None else Some ()) - !Location.input_name outputprefix modulename env ast in - let typedtree_coercion = (typedtree, coercion) in - print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion typedtree_coercion ; - if !Clflags.print_types || !Js_config.cmi_only then begin - Warnings.check_fatal (); - end else begin - let lambda = Translmod.transl_implementation modulename typedtree_coercion in - let js_program = - print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda.code - |> Lam_compile_main.compile outputprefix in - if not !Js_config.cmj_only then - Lam_compile_main.lambda_as_module - js_program - outputprefix - ; - end; - process_with_gentype (outputprefix ^ ".cmt") - end + Binary_ast.write_ast ~sourcefile:!Location.input_name Ml + ~output: + ( outputprefix + ^ + if !Js_config.is_reason then Literals.suffix_reast + else Literals.suffix_mlast ) + ast; + if !Js_config.syntax_only then Warnings.check_fatal () + else + let modulename = Ext_filename.module_name outputprefix in + Lam_compile_env.reset (); + let env = Compmisc.initial_env () in + Env.set_unit_name modulename; + let typedtree, coercion, _, _ = + Typemod.type_implementation_more + ?check_exists:(if !Js_config.force_cmi then None else Some ()) + !Location.input_name outputprefix modulename env ast + in + let typedtree_coercion = (typedtree, coercion) in + print_if ppf Clflags.dump_typedtree Printtyped.implementation_with_coercion + typedtree_coercion; + ( if !Clflags.print_types || !Js_config.cmi_only then Warnings.check_fatal () + else + let lambda = + Translmod.transl_implementation modulename typedtree_coercion + in + let js_program = + print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda lambda.code + |> Lam_compile_main.compile outputprefix + in + if not !Js_config.cmj_only then + Lam_compile_main.lambda_as_module js_program outputprefix ); + process_with_gentype (outputprefix ^ ".cmt") + + let implementation ppf fname outputprefix = Compmisc.init_path false; Pparse.parse_implementation ~tool_name:Js_config.tool_name ppf fname |> Ppx_entry.rewrite_implementation |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix + |> after_parsing_impl ppf outputprefix + -let implementation_mlast ppf fname outputprefix = +let implementation_mlast ppf fname outputprefix = Compmisc.init_path false; Binary_ast.read_ast Ml fname |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix - - - - - + |> after_parsing_impl ppf outputprefix let make_structure_item ~ns cunit : Parsetree.structure_item = - let open Ast_helper in - let loc = Location.none in - Str.module_ - (Mb.mk {txt = cunit; loc } - (Mod.ident - {txt = Lident - ( Ext_namespace.make ~ns cunit) - ; loc})) - - -(** decoding [.mlmap] - keep in sync {!Bsb_namespace_map_gen.output} -*) -let implementation_map ppf sourcefile outputprefix = - let () = Js_config.cmj_only := true in - let ichan = open_in_bin sourcefile in - seek_in ichan (Ext_digest.length +1); - let list_of_modules = Ext_io.rev_lines_of_chann ichan in + let open Ast_helper in + let loc = Location.none in + Str.module_ + (Mb.mk { txt = cunit; loc } + (Mod.ident { txt = Lident (Ext_namespace.make ~ns cunit); loc })) + + +(** decoding [.mlmap] keep in sync {!Bsb_namespace_map_gen.output} *) +let implementation_map ppf sourcefile outputprefix = + let () = Js_config.cmj_only := true in + let ichan = open_in_bin sourcefile in + seek_in ichan (Ext_digest.length + 1); + let list_of_modules = Ext_io.rev_lines_of_chann ichan in close_in ichan; let ns = Ext_filename.module_name sourcefile in - let ml_ast = Ext_list.fold_left list_of_modules [] (fun acc line -> - if Ext_string.is_empty line then acc - else make_structure_item ~ns line :: acc - ) in + let ml_ast = + Ext_list.fold_left list_of_modules [] (fun acc line -> + if Ext_string.is_empty line then acc + else make_structure_item ~ns line :: acc) + in Compmisc.init_path false; ml_ast |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation |> print_if_pipe ppf Clflags.dump_source Pprintast.structure - |> after_parsing_impl ppf outputprefix - + |> after_parsing_impl ppf outputprefix end module Ocaml_options : sig @@ -418911,107 +418564,88 @@ end = struct (* *) (***********************************************************************) - let process_interface_file ppf name = Js_implementation.interface ppf name (Compenv.output_prefix name) + + let process_implementation_file ppf name = Js_implementation.implementation ppf name (Compenv.output_prefix name) -let setup_reason_context () = +let setup_reason_context () = Js_config.is_reason := true; - Clflags.preprocessor := None ; (* FIX #3988*) - Lazy.force Super_main.setup; + Clflags.preprocessor := None; + (* FIX #3988*) + Lazy.force Super_main.setup; Lazy.force Reason_outcome_printer_main.setup -let reason_pp ~sourcefile = + +let reason_pp ~sourcefile = setup_reason_context (); Ast_reason_pp.pp sourcefile -type valid_input = - | Ml + +type valid_input = + | Ml | Mli | Re | Rei - | Mlast - | Mliast + | Mlast + | Mliast | Reast | Reiast | Mlmap | Cmi -(** This is per-file based, - when [ocamlc] [-c -o another_dir/xx.cmi] - it will return (another_dir/xx) -*) - - -let process_file ppf sourcefile = - (* This is a better default then "", it will be changed later - The {!Location.input_name} relies on that we write the binary ast - properly - *) - Location.set_input_name sourcefile; - let ext = Ext_filename.get_extension_maybe sourcefile in - let input = - if ext = Literals.suffix_ml then - Ml - else if ext = Literals.suffix_re then - Re - else if ext = !Config.interface_suffix then - Mli - else if ext = Literals.suffix_rei then - Rei - else if ext = Literals.suffix_mlast then - Mlast - else if ext = Literals.suffix_mliast then - Mliast - else if ext = Literals.suffix_reast then - Reast - else if ext = Literals.suffix_reiast then - Reiast - else if ext = Literals.suffix_mlmap then - Mlmap - else if ext = Literals.suffix_cmi then - Cmi - else - raise(Arg.Bad("don't know what to do with " ^ sourcefile)) in - let opref = Compenv.output_prefix sourcefile in - match input with - | Re -> - setup_reason_context (); - let tmpfile = reason_pp ~sourcefile in - Js_implementation.implementation ppf tmpfile opref ; - Ast_reason_pp.clean tmpfile +(** This is per-file based, when [ocamlc] [-c -o another_dir/xx.cmi] it will + return (another_dir/xx) *) + +let process_file ppf sourcefile = + (* This is a better default then "", it will be changed later The + {!Location.input_name} relies on that we write the binary ast properly *) + Location.set_input_name sourcefile; + let ext = Ext_filename.get_extension_maybe sourcefile in + let input = + if ext = Literals.suffix_ml then Ml + else if ext = Literals.suffix_re then Re + else if ext = !Config.interface_suffix then Mli + else if ext = Literals.suffix_rei then Rei + else if ext = Literals.suffix_mlast then Mlast + else if ext = Literals.suffix_mliast then Mliast + else if ext = Literals.suffix_reast then Reast + else if ext = Literals.suffix_reiast then Reiast + else if ext = Literals.suffix_mlmap then Mlmap + else if ext = Literals.suffix_cmi then Cmi + else raise (Arg.Bad ("don't know what to do with " ^ sourcefile)) + in + let opref = Compenv.output_prefix sourcefile in + match input with + | Re -> + setup_reason_context (); + let tmpfile = reason_pp ~sourcefile in + Js_implementation.implementation ppf tmpfile opref; + Ast_reason_pp.clean tmpfile | Rei -> - setup_reason_context (); - let tmpfile = (reason_pp ~sourcefile) in - Js_implementation.interface ppf tmpfile opref ; - Ast_reason_pp.clean tmpfile - | Reiast - -> - setup_reason_context (); - Js_implementation.interface_mliast ppf sourcefile opref - | Reast - -> - setup_reason_context (); - Js_implementation.implementation_mlast ppf sourcefile opref - | Ml -> - Js_implementation.implementation ppf sourcefile opref - | Mli -> - Js_implementation.interface ppf sourcefile opref - | Mliast - -> Js_implementation.interface_mliast ppf sourcefile opref - | Mlast - -> Js_implementation.implementation_mlast ppf sourcefile opref - | Mlmap - -> Js_implementation.implementation_map ppf sourcefile opref - | Cmi - -> - let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in - Printtyp.signature Format.std_formatter cmi_sign ; - Format.pp_print_newline Format.std_formatter () - + setup_reason_context (); + let tmpfile = reason_pp ~sourcefile in + Js_implementation.interface ppf tmpfile opref; + Ast_reason_pp.clean tmpfile + | Reiast -> + setup_reason_context (); + Js_implementation.interface_mliast ppf sourcefile opref + | Reast -> + setup_reason_context (); + Js_implementation.implementation_mlast ppf sourcefile opref + | Ml -> Js_implementation.implementation ppf sourcefile opref + | Mli -> Js_implementation.interface ppf sourcefile opref + | Mliast -> Js_implementation.interface_mliast ppf sourcefile opref + | Mlast -> Js_implementation.implementation_mlast ppf sourcefile opref + | Mlmap -> Js_implementation.implementation_map ppf sourcefile opref + | Cmi -> + let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in + Printtyp.signature Format.std_formatter cmi_sign; + Format.pp_print_newline Format.std_formatter () + let usage = "Usage: bsc \nOptions are:" @@ -419019,243 +418653,168 @@ let ppf = Format.err_formatter (* Error messages to standard error formatter *) let anonymous filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_file ppf filename;; + Compenv.readenv ppf (Before_compile filename); + process_file ppf filename + + let impl filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_implementation_file ppf filename;; -let intf filename = - Compenv.readenv ppf - (Before_compile filename) - ; process_interface_file ppf filename;; + Compenv.readenv ppf (Before_compile filename); + process_implementation_file ppf filename + +let intf filename = + Compenv.readenv ppf (Before_compile filename); + process_interface_file ppf filename let eval (s : string) ~suffix = - let tmpfile = Filename.temp_file "eval" suffix in - Ext_io.write_file tmpfile s; - anonymous tmpfile; + let tmpfile = Filename.temp_file "eval" suffix in + Ext_io.write_file tmpfile s; + anonymous tmpfile; Ast_reason_pp.clean tmpfile - -let (//) = Filename.concat +let ( // ) = Filename.concat - - - let define_variable s = match Ext_string.split ~keep_empty:true s '=' with - | [key; v] -> - if not @@ Lexer.define_key_value key v then - raise (Arg.Bad ("illegal definition: " ^ s)) + | [ key; v ] -> + if not @@ Lexer.define_key_value key v then + raise (Arg.Bad ("illegal definition: " ^ s)) | _ -> raise (Arg.Bad ("illegal definition: " ^ s)) - + let buckle_script_flags : (string * Arg.spec * string) list = - ("-bs-super-errors", - Arg.Unit - (* needs to be set here instead of, say, setting a - Js_config.better_errors flag; otherwise, when `anonymous` runs, we - don't have time to set the custom printer before it starts outputting - warnings *) - (fun _ -> Lazy.force Super_main.setup) - , - " Better error message combined with other tools " - ) - :: - ("-bs-re-out", - Arg.Unit (fun _ -> Lazy.force Reason_outcome_printer_main.setup), - " Print compiler output in Reason syntax" - ) - :: - ("-bs-jsx", - Arg.Int (fun i -> Js_config.jsx_version := i), - " Set jsx version" - ) - :: - ("-bs-refmt", - Arg.String (fun s -> Js_config.refmt := Some s), - " Set customized refmt path" - ) - - :: - ( - "-bs-gentype", - Arg.String (fun s -> Clflags.bs_gentype := Some s), - " Pass gentype command" - ) - :: - ("-bs-suffix", - Arg.Set Js_config.bs_suffix, - " Set suffix to .bs.js" - ) - :: - ("-bs-no-implicit-include", Arg.Set Clflags.no_implicit_current_dir - , " Don't include current dir implicitly") - :: - ("-bs-read-cmi", Arg.Unit (fun _ -> Clflags.assume_no_mli := Clflags.Mli_exists), - " (internal) Assume mli always exist ") - :: - ("-bs-D", Arg.String define_variable, - " Define conditional variable e.g, -D DEBUG=true" - ) - :: - ("-bs-quiet", Arg.Set Clflags.bs_quiet, - " Quiet mode (no warnings printed)" - ) - :: - ("-bs-list-conditionals", - Arg.Unit (fun () -> Lexer.list_variables Format.err_formatter), - " List existing conditional variables") - :: - ( - "-bs-binary-ast", Arg.Set Js_config.binary_ast, - " Generate binary .mli_ast and ml_ast" - ) - :: - ( - "-bs-simple-binary-ast", Arg.Set Js_config.simple_binary_ast, - " Generate binary .mliast_simple and mlast_simple" - ) - :: - ("-bs-syntax-only", - Arg.Set Js_config.syntax_only, - " only check syntax" - ) - :: - ("-bs-no-bin-annot", Arg.Clear Clflags.binary_annotations, - " disable binary annotations (by default on)") - :: - ("-bs-eval", - Arg.String (fun s -> eval s ~suffix:Literals.suffix_ml), - " (experimental) Set the string to be evaluated in OCaml syntax" - ) - :: - ("-e", - Arg.String (fun s -> eval s ~suffix:Literals.suffix_re), - " (experimental) Set the string to be evaluated in ReasonML syntax" - ) - :: - ( - "-bs-cmi-only", - Arg.Set Js_config.cmi_only, - " Stop after generating cmi file" - ) - :: - ( - "-bs-cmi", - Arg.Set Js_config.force_cmi, - " Not using cached cmi, always generate cmi" - ) - :: - ("-bs-cmj", - Arg.Set Js_config.force_cmj, - " Not using cached cmj, always generate cmj" - ) - :: - ("-bs-g", - Arg.Unit - (fun _ -> Js_config.debug := true; - Lexer.replace_directive_bool "DEBUG" true - ), - " debug mode" - ) - :: - ( - "-bs-sort-imports", - Arg.Set Js_config.sort_imports, - " Sort the imports by lexical order so the output will be more stable (default false)" - ) - :: - ( "-bs-no-sort-imports", - Arg.Clear Js_config.sort_imports, - " No sort (see -bs-sort-imports)" - ) - :: - ("-bs-package-name", - Arg.String Js_packages_state.set_package_name, - " set package name, useful when you want to produce npm packages") - :: - ( "-bs-ns", - Arg.String Js_packages_state.set_package_map, - " set package map, not only set package name but also use it as a namespace" - ) - :: - ("-bs-no-version-header", - Arg.Set Js_config.no_version_header, - " Don't print version header" - ) - :: - ("-bs-package-output", - Arg.String - Js_packages_state.update_npm_package_path, - " set npm-output-path: [opt_module]:path, for example: 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' ") - :: - ("-bs-no-warn-unimplemented-external", - Arg.Set Js_config.no_warn_unimplemented_external, - " disable warnings on unimplmented c externals" - ) - :: - ("-bs-no-builtin-ppx-ml", - Arg.Set Js_config.no_builtin_ppx_ml, - "disable built-in ppx for ml files (internal use)") - :: - ("-bs-no-builtin-ppx-mli", - Arg.Set Js_config.no_builtin_ppx_mli, - "disable built-in ppx for mli files (internal use)") - :: - ("-bs-cross-module-opt", - Arg.Set Js_config.cross_module_inline, - "enable cross module inlining(experimental), default(false)") - :: - ("-bs-diagnose", - Arg.Set Js_config.diagnose, - " More verbose output") - :: - ("-bs-no-check-div-by-zero", - Arg.Clear Js_config.check_div_by_zero, - " unsafe mode, don't check div by zero and mod by zero") - :: - ("-bs-noassertfalse", - Arg.Set Clflags.no_assert_false, - " no code for assert false" - ) - :: - ("-bs-loc", - Arg.Set Clflags.dump_location, - " dont display location with -dtypedtree, -dparsetree" - ) - :: Ocaml_options.mk_impl - (fun file -> Js_config.js_stdout := false; impl file ) - :: Ocaml_options.mk_intf - (fun file -> Js_config.js_stdout := false ; intf file) + ( "-bs-super-errors", + Arg.Unit + (* needs to be set here instead of, say, setting a Js_config.better_errors + flag; otherwise, when `anonymous` runs, we don't have time to set the + custom printer before it starts outputting warnings *) + (fun _ -> Lazy.force Super_main.setup), + " Better error message combined with other tools " ) + :: ( "-bs-re-out", + Arg.Unit (fun _ -> Lazy.force Reason_outcome_printer_main.setup), + " Print compiler output in Reason syntax" ) + :: ( "-bs-jsx", + Arg.Int (fun i -> Js_config.jsx_version := i), + " Set jsx version" ) + :: ( "-bs-refmt", + Arg.String (fun s -> Js_config.refmt := Some s), + " Set customized refmt path" ) + :: ( "-bs-gentype", + Arg.String (fun s -> Clflags.bs_gentype := Some s), + " Pass gentype command" ) + :: ( "-bs-suffix", + Arg.Unit Js_package_info.deprecated_set_bs_extension, + " (DEPRECATED) Set default suffix to .bs.js - use third compoment of \ + -bs-package-output instead" ) + :: ( "-bs-no-implicit-include", + Arg.Set Clflags.no_implicit_current_dir, + " Don't include current dir implicitly" ) + :: ( "-bs-read-cmi", + Arg.Unit (fun _ -> Clflags.assume_no_mli := Clflags.Mli_exists), + " (internal) Assume mli always exist " ) + :: ( "-bs-D", + Arg.String define_variable, + " Define conditional variable e.g, -D DEBUG=true" ) + :: ("-bs-quiet", Arg.Set Clflags.bs_quiet, " Quiet mode (no warnings printed)") + :: ( "-bs-list-conditionals", + Arg.Unit (fun () -> Lexer.list_variables Format.err_formatter), + " List existing conditional variables" ) + :: ( "-bs-binary-ast", + Arg.Set Js_config.binary_ast, + " Generate binary .mli_ast and ml_ast" ) + :: ( "-bs-simple-binary-ast", + Arg.Set Js_config.simple_binary_ast, + " Generate binary .mliast_simple and mlast_simple" ) + :: ("-bs-syntax-only", Arg.Set Js_config.syntax_only, " only check syntax") + :: ( "-bs-no-bin-annot", + Arg.Clear Clflags.binary_annotations, + " disable binary annotations (by default on)" ) + :: ( "-bs-eval", + Arg.String (fun s -> eval s ~suffix:Literals.suffix_ml), + " (experimental) Set the string to be evaluated in OCaml syntax" ) + :: ( "-e", + Arg.String (fun s -> eval s ~suffix:Literals.suffix_re), + " (experimental) Set the string to be evaluated in ReasonML syntax" ) + :: ( "-bs-cmi-only", + Arg.Set Js_config.cmi_only, + " Stop after generating cmi file" ) + :: ( "-bs-cmi", + Arg.Set Js_config.force_cmi, + " Not using cached cmi, always generate cmi" ) + :: ( "-bs-cmj", + Arg.Set Js_config.force_cmj, + " Not using cached cmj, always generate cmj" ) + :: ( "-bs-g", + Arg.Unit + (fun _ -> + Js_config.debug := true; + Lexer.replace_directive_bool "DEBUG" true), + " debug mode" ) + :: ( "-bs-sort-imports", + Arg.Set Js_config.sort_imports, + " Sort the imports by lexical order so the output will be more stable \ + (default false)" ) + :: ( "-bs-no-sort-imports", + Arg.Clear Js_config.sort_imports, + " No sort (see -bs-sort-imports)" ) + :: ( "-bs-package-name", + Arg.String Js_current_package_info.set_package_name, + " set package name, useful when you want to produce npm packages" ) + :: ( "-bs-ns", + Arg.String Js_current_package_info.set_package_map, + " set package map, not only set package name but also use it as a \ + namespace" ) + :: ( "-bs-no-version-header", + Arg.Set Js_config.no_version_header, + " Don't print version header" ) + :: ( "-bs-package-output", + Arg.String Js_current_package_info.append_location_descriptor_of_string, + " set npm-output-path: [opt_module]:path:[ext], for example: 'lib/cjs', \ + 'amdjs:lib/amdjs', 'es6:lib/es6:mjs' " ) + :: ( "-bs-no-warn-unimplemented-external", + Arg.Set Js_config.no_warn_unimplemented_external, + " disable warnings on unimplmented c externals" ) + :: ( "-bs-no-builtin-ppx-ml", + Arg.Set Js_config.no_builtin_ppx_ml, + "disable built-in ppx for ml files (internal use)" ) + :: ( "-bs-no-builtin-ppx-mli", + Arg.Set Js_config.no_builtin_ppx_mli, + "disable built-in ppx for mli files (internal use)" ) + :: ( "-bs-cross-module-opt", + Arg.Set Js_config.cross_module_inline, + "enable cross module inlining(experimental), default(false)" ) + :: ("-bs-diagnose", Arg.Set Js_config.diagnose, " More verbose output") + :: ( "-bs-no-check-div-by-zero", + Arg.Clear Js_config.check_div_by_zero, + " unsafe mode, don't check div by zero and mod by zero" ) + :: ( "-bs-noassertfalse", + Arg.Set Clflags.no_assert_false, + " no code for assert false" ) + :: ( "-bs-loc", + Arg.Set Clflags.dump_location, + " dont display location with -dtypedtree, -dparsetree" ) + :: Ocaml_options.mk_impl (fun file -> + Js_config.js_stdout := false; + impl file) + :: Ocaml_options.mk_intf (fun file -> + Js_config.js_stdout := false; + intf file) :: Ocaml_options.mk__ anonymous :: Ocaml_options.ocaml_options - - - -let _ = - (* ( - print_endline - ("BSB_PROJECT_ROOT :" ^ - match Sys.getenv_opt "BSB_PROJECT_ROOT" with - | None -> "None" - | Some s -> s - )); *) +let _ = + (* ( print_endline ("BSB_PROJECT_ROOT :" ^ match Sys.getenv_opt + "BSB_PROJECT_ROOT" with | None -> "None" | Some s -> s )); *) Bs_conditional_initial.setup_env (); try Compenv.readenv ppf Before_args; - Arg.parse buckle_script_flags anonymous usage - with x -> - begin - - Location.report_exception ppf x; - exit 2 - end + Arg.parse buckle_script_flags anonymous usage + with x -> + Ext_obj.bt (); + Location.report_exception ppf x; + exit 2 end diff --git a/lib/4.06.1/whole_compiler.ml.d b/lib/4.06.1/whole_compiler.ml.d index 5be837f182..eb8bcb888f 100644 --- a/lib/4.06.1/whole_compiler.ml.d +++ b/lib/4.06.1/whole_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/driver/pparse.ml ../ocaml/driver/pparse.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_invariants.ml ../ocaml/parsing/ast_invariants.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/depend.ml ../ocaml/parsing/depend.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/printast.ml ../ocaml/parsing/printast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/printtyped.ml ../ocaml/typing/printtyped.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./common/ml_binary.ml ./common/ml_binary.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_implementation.ml ./core/js_implementation.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/ocaml_options.ml ./core/ocaml_options.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/ast_extract.ml ./depends/ast_extract.mli ./depends/binary_ast.ml ./depends/binary_ast.mli ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_format.ml ./ext/ext_format.mli ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/js_main.ml ./main/js_main.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./outcome_printer/reason_outcome_printer_main.ml ./outcome_printer/reason_syntax_util.ml ./outcome_printer/reason_syntax_util.mli ./outcome_printer/tweaked_reason_oprint.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file +../lib/4.06.1/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/driver/compenv.ml ../ocaml/driver/compenv.mli ../ocaml/driver/compmisc.ml ../ocaml/driver/compmisc.mli ../ocaml/driver/pparse.ml ../ocaml/driver/pparse.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_invariants.ml ../ocaml/parsing/ast_invariants.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/depend.ml ../ocaml/parsing/depend.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/printast.ml ../ocaml/parsing/printast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/printtyped.ml ../ocaml/typing/printtyped.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/terminfo.ml ../ocaml/utils/terminfo.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./common/ml_binary.ml ./common/ml_binary.mli ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/classify_function.ml ./core/classify_function.mli ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_current_package_info.ml ./core/js_current_package_info.mli ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_implementation.ml ./core/js_implementation.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_polyvar.ml ./core/js_of_lam_polyvar.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_tuple.ml ./core/js_of_lam_tuple.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_package_info.ml ./core/js_package_info.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_exp_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_inline_util.ml ./core/lam_inline_util.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/ocaml_options.ml ./core/ocaml_options.mli ./core/primitive_compat.ml ./core/primitive_compat.mli ./core/record_attributes_check.ml ./depends/ast_extract.ml ./depends/ast_extract.mli ./depends/binary_ast.ml ./depends/binary_ast.mli ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_warnings.ml ./ext/ext_arg.ml ./ext/ext_arg.mli ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_format.ml ./ext/ext_format.mli ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_json_parse.ml ./ext/ext_json_parse.mli ./ext/ext_json_types.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_obj.ml ./ext/ext_obj.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_position.ml ./ext/ext_position.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/literals.mli ./ext/map_gen.ml ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/js_main.ml ./main/js_main.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./outcome_printer/reason_outcome_printer_main.ml ./outcome_printer/reason_syntax_util.ml ./outcome_printer/reason_syntax_util.mli ./outcome_printer/tweaked_reason_oprint.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_reason_react.ml ./super_errors/super_reason_react.mli ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./super_errors/super_warnings.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_raw.ml ./syntax/ast_raw.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/reactjs_jsx_ppx_v2.ml ./syntax/reactjs_jsx_ppx_v3.ml \ No newline at end of file diff --git a/package-lock.json b/package-lock.json index 3be3e966b0..a538005844 100644 --- a/package-lock.json +++ b/package-lock.json @@ -553,6 +553,12 @@ "integrity": "sha1-F0uSaHNVNP+8es5r9TpanhtcX18=", "dev": true }, + "prettier": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/prettier/-/prettier-2.0.4.tgz", + "integrity": "sha512-SVJIQ51spzFDvh4fIbCLvciiDMCrRhlN3mbZvv/+ycjvmF5E73bKdGfU8QDLNmjYJf+lsGnDBC4UUnvTe5OO0w==", + "dev": true + }, "require-directory": { "version": "2.1.1", "resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz", diff --git a/package.json b/package.json index b44c08d212..3bf14a8df5 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,7 @@ { "devDependencies": { - "mocha": "^6.2.2" + "mocha": "^6.2.2", + "prettier": "^2.0.4" }, "bin": { "bsb": "lib/bsb",