From f770e260c71d523eee6b8e973b0af5dfdf1053a6 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 10:32:45 +0200 Subject: [PATCH 01/13] Add -bs-project-root flag so bsc no longer walks for rescript.json MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The compiler's Ext_path.package_dir lazily walked the filesystem from cwd until it found rescript.json, solely to determine the JS output root in lam_compile_main. That walk is unnecessary when rewatch is driving the compile — rewatch already knows the package root. - compiler: add custom_package_dir ref in Ext_path; convert package_dir to a unit -> string that prefers the ref and falls back to the existing walk. Add -bs-project-root CLI flag on bsc. - rewatch: emit -bs-project-root from compiler_args for every bsc invocation. No behavioral change for users; this is the first step toward removing direct rescript.json reads from bsc entirely. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/bsc/rescript_compiler_main.ml | 4 ++++ compiler/core/lam_compile_main.ml | 6 +++--- compiler/ext/ext_path.ml | 11 ++++++++++- compiler/ext/ext_path.mli | 9 +++++++-- rewatch/src/build/compile.rs | 2 ++ rewatch/src/config.rs | 14 ++++++++++++++ 6 files changed, 40 insertions(+), 6 deletions(-) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index c818eac295a..f69f39901e2 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -263,6 +263,10 @@ let command_line_flags : (string * Bsc_args.spec * string) array = string_call Js_packages_state.update_npm_package_path, "*internal* Set npm-output-path: [opt_module]:path, for example: \ 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' " ); + ( "-bs-project-root", + string_call (fun s -> Ext_path.custom_package_dir := Some s), + "*internal* Set the project root directory, avoiding a filesystem walk \ + for rescript.json" ); ( "-bs-ast", unit_call (fun _ -> Js_config.binary_ast := true; diff --git a/compiler/core/lam_compile_main.ml b/compiler/core/lam_compile_main.ml index cc33a2bcfb5..cdecf32ef8e 100644 --- a/compiler/core/lam_compile_main.ml +++ b/compiler/core/lam_compile_main.ml @@ -314,12 +314,12 @@ let lambda_as_module let basename = Ext_namespace.change_ext_ns_suffix (Filename.basename output_prefix) suffix in - let target_file = - (Lazy.force Ext_path.package_dir // + let target_file = + (Ext_path.package_dir () // path // basename (* #913 only generate little-case js file *) - ) in + ) in (if not !Clflags.dont_write_files then Ext_pervasives.with_file_as_chan target_file output_chan ); diff --git a/compiler/ext/ext_path.ml b/compiler/ext/ext_path.ml index ac36f0eca3f..0f04895895e 100644 --- a/compiler/ext/ext_path.ml +++ b/compiler/ext/ext_path.ml @@ -127,4 +127,13 @@ let rec find_root_filename ~cwd filenames = let find_config_dir cwd = find_root_filename ~cwd [Literals.rescript_json] -let package_dir = lazy (find_config_dir (Lazy.force cwd)) +(* When set (e.g. by the build system via -bs-project-root), we skip the + directory walk entirely. *) +let custom_package_dir : string option ref = ref None + +let fallback_package_dir = lazy (find_config_dir (Lazy.force cwd)) + +let package_dir () = + match !custom_package_dir with + | Some dir -> dir + | None -> Lazy.force fallback_package_dir diff --git a/compiler/ext/ext_path.mli b/compiler/ext/ext_path.mli index 1c0f15c1315..e68eae360d0 100644 --- a/compiler/ext/ext_path.mli +++ b/compiler/ext/ext_path.mli @@ -29,5 +29,10 @@ val node_rebase_file : from:string -> to_:string -> string -> string val absolute_cwd_path : string -> string -(* It is lazy so that it will not hit errors when in script mode *) -val package_dir : string Lazy.t +val custom_package_dir : string option ref +(** When set, [package_dir ()] returns this value instead of walking the + filesystem. Typically set by the build system via [-bs-project-root]. *) + +val package_dir : unit -> string +(** Returns the package root directory. Evaluated on demand so that script + mode does not hit the filesystem walk when [custom_package_dir] is unset. *) diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index 5247342a2a3..87bf58c5dd4 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -567,6 +567,7 @@ pub fn compiler_args( }; let package_name_arg = vec!["-bs-package-name".to_string(), config.name.to_owned()]; + let project_root_args = config.get_project_root_args(); let implementation_args = if is_interface { debug!("Compiling interface file: {}", &module_name); @@ -627,6 +628,7 @@ pub fn compiler_args( // we should probably parse the right ones from the package config // vec!["-w".to_string(), "a".to_string()], package_name_arg, + project_root_args, implementation_args, // vec![ // "-I".to_string(), diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 1f0ea703489..921e207980b 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -605,6 +605,20 @@ impl Config { } } + /// Directory containing the `rescript.json` this config was parsed from. + pub fn get_package_root(&self) -> &Path { + self.path + .parent() + .expect("rescript.json path should always have a parent directory") + } + + pub fn get_project_root_args(&self) -> Vec { + vec![ + "-bs-project-root".to_string(), + self.get_package_root().to_string_lossy().to_string(), + ] + } + pub fn get_warning_args(&self, is_local_dep: bool, warn_error_override: Option) -> Vec { // Ignore warning config for non local dependencies (node_module dependencies) if !is_local_dep { From 072c7abc0731494d6b03971601b2feb37fcdf208 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 10:44:05 +0200 Subject: [PATCH 02/13] Move gentype config from rescript.json to CLI flags MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The gentype backend was the last site in bsc that parsed rescript.json directly (via GenTypeConfig.read_config walking up from cwd). Rewatch already parses that file, so it can hand the needed fields to bsc as CLI flags, eliminating the filesystem walk and the duplicated JSON reading. Compiler side: - GenTypeConfig.ml: drop the JSON reader. Replace with module-level refs populated by bsc CLI flags, plus `build_config ~namespace` that assembles a Config.t from those refs. - New bsc flags: -bs-gentype-module, -bs-gentype-module-resolution, -bs-gentype-export-interfaces, -bs-gentype-generated-extension, -bs-gentype-suffix, -bs-gentype-shim, -bs-gentype-debug, -bs-gentype-dep, -bs-gentype-source-dir, -bs-gentype-bsb-project-root. -bs-project-root now also populates GenTypeConfig.project_root. - Config.t.sources becomes a `string list` (pre-expanded directories) instead of raw Ext_json_types, simplifying ModuleResolver. - Debug.set_item takes a bool-implied item name instead of an Ext_json_types.t value. - Paths.ml: drop get_config_file; read_config is now a thin wrapper around build_config. Rewatch side: - Replace `GenTypeConfig = serde_json::Value` with a typed struct; Deserialize supports both the object and (deprecated) array forms of `shims`. - New Config::get_gentype_args assembles the full -bs-gentype-* flag set from the typed gentypeconfig, suffix, dependencies, pre-expanded source dirs, and workspace root. - compile.rs: when gentype is enabled, walk the package's declared source folders (honoring `subdirs: true`) to produce the directory list gentype needs for cross-file shim resolution — `package.dirs` alone only tracks dirs with .res files. Generated .gen.tsx / .bs.js output is byte-identical; all existing gentype and full test suites pass. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/bsc/rescript_compiler_main.ml | 43 +++- compiler/gentype/Debug.ml | 29 ++- compiler/gentype/GenTypeConfig.ml | 274 +++++++++---------------- compiler/gentype/ModuleResolver.ml | 47 ++--- compiler/gentype/Paths.ml | 8 +- rewatch/src/build.rs | 1 + rewatch/src/build/compile.rs | 65 +++++- rewatch/src/config.rs | 218 +++++++++++++++++++- 8 files changed, 437 insertions(+), 248 deletions(-) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index f69f39901e2..46c8d0e1ee6 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -264,7 +264,9 @@ let command_line_flags : (string * Bsc_args.spec * string) array = "*internal* Set npm-output-path: [opt_module]:path, for example: \ 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' " ); ( "-bs-project-root", - string_call (fun s -> Ext_path.custom_package_dir := Some s), + string_call (fun s -> + Ext_path.custom_package_dir := Some s; + GenTypeConfig.project_root := s), "*internal* Set the project root directory, avoiding a filesystem walk \ for rescript.json" ); ( "-bs-ast", @@ -297,6 +299,45 @@ let command_line_flags : (string * Bsc_args.spec * string) array = set Clflags.transparent_modules, "*internal*Do not record dependencies for module aliases" ); ("-bs-gentype", set Clflags.bs_gentype, "*internal* Pass gentype command"); + ( "-bs-gentype-module", + string_call (fun s -> + GenTypeConfig.module_flag := GenTypeConfig.module_of_string s), + "*internal* Set gentype module system: commonjs|esmodule" ); + ( "-bs-gentype-module-resolution", + string_call (fun s -> + GenTypeConfig.module_resolution_flag := + GenTypeConfig.module_resolution_of_string s), + "*internal* Set gentype module resolution strategy: node|node16|bundler" + ); + ( "-bs-gentype-export-interfaces", + set GenTypeConfig.export_interfaces_flag, + "*internal* Emit gentype interface files" ); + ( "-bs-gentype-generated-extension", + string_call (fun s -> + GenTypeConfig.generated_file_extension_flag := Some s), + "*internal* Set gentype generated-file extension (e.g. .gen.tsx)" ); + ( "-bs-gentype-suffix", + string_call (fun s -> GenTypeConfig.suffix_flag := Some s), + "*internal* Set gentype import-path suffix (e.g. .bs.js, .mjs)" ); + ( "-bs-gentype-shim", + string_call GenTypeConfig.add_shim, + "*internal* Register a gentype shim mapping: From=To (repeatable)" ); + ( "-bs-gentype-debug", + string_call Debug.set_item, + "*internal* Enable a gentype debug category (repeatable): \ + all|basic|codeItems|config|converter|dependencies|moduleResolution|notImplemented|translation|typeEnv|typeResolution" + ); + ( "-bs-gentype-dep", + string_call GenTypeConfig.add_bs_dependency, + "*internal* Register a gentype bsb dependency (repeatable)" ); + ( "-bs-gentype-source-dir", + string_call GenTypeConfig.add_source_dir, + "*internal* Register a gentype source directory relative to the project \ + root (repeatable)" ); + ( "-bs-gentype-bsb-project-root", + string_call (fun s -> GenTypeConfig.bsb_project_root := s), + "*internal* Set gentype bsb project root (workspace root containing \ + .sourcedirs.json)" ); (******************************************************************************) ( "-unboxed-types", set Clflags.unboxed_types, diff --git a/compiler/gentype/Debug.ml b/compiler/gentype/Debug.ml index 193db60c012..ce89e792dba 100644 --- a/compiler/gentype/Debug.ml +++ b/compiler/gentype/Debug.ml @@ -21,22 +21,17 @@ let set_all () = type_env := true; type_resolution := true -let set_item debug_item debug_value = - let is_on = - match debug_value with - | Ext_json_types.True _ -> true - | _ -> false - in +let set_item debug_item = match debug_item with - | "all" when is_on -> set_all () - | "basic" -> basic := is_on - | "codeItems" -> code_items := is_on - | "config" -> config := is_on - | "converter" -> converter := is_on - | "dependencies" -> dependencies := is_on - | "moduleResolution" -> module_resolution := is_on - | "notImplemented" -> not_implemented := is_on - | "translation" -> translation := is_on - | "typeEnv" -> type_env := is_on - | "typeResolution" -> type_resolution := is_on + | "all" -> set_all () + | "basic" -> basic := true + | "codeItems" -> code_items := true + | "config" -> config := true + | "converter" -> converter := true + | "dependencies" -> dependencies := true + | "moduleResolution" -> module_resolution := true + | "notImplemented" -> not_implemented := true + | "translation" -> translation := true + | "typeEnv" -> type_env := true + | "typeResolution" -> type_resolution := true | _ -> () diff --git a/compiler/gentype/GenTypeConfig.ml b/compiler/gentype/GenTypeConfig.ml index cba7a6787d6..1790871b274 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -13,7 +13,7 @@ type module_resolution = type bs_version = int * int * int type t = { - mutable bsb_project_root: string; + bsb_project_root: string; bs_dependencies: string list; mutable emit_import_curry: bool; mutable emit_import_react: bool; @@ -25,9 +25,9 @@ type t = { module_resolution: module_resolution; namespace: string option; platform_lib: string; - mutable project_root: string; + project_root: string; shims_map: ModuleName.t ModuleNameMap.t; - sources: Ext_json_types.t option; + sources: string list; suffix: string; } @@ -47,7 +47,7 @@ let default = platform_lib = ""; project_root = ""; shims_map = ModuleNameMap.empty; - sources = None; + sources = []; suffix = ".bs.js"; } @@ -59,187 +59,103 @@ let bs_platform_lib ~config = let get_bs_curry_path ~config = Filename.concat (bs_platform_lib ~config) "curry.js" -type map = Ext_json_types.t Map_string.t - -let get_opt s (map : map) = Map_string.find_opt map s - -let get_bool s map = - match map |> get_opt s with - | Some (True _) -> Some true - | Some (False _) -> Some false +(* ----- CLI-flag backing state ----------------------------------------- *) + +(** The following refs are populated by bsc's CLI flags (registered in + [rescript_compiler_main.ml]). Everything the gentype config used to read + from [rescript.json] now comes through here instead. *) + +let project_root = ref "" +let bsb_project_root = ref "" +let module_flag : module_ option ref = ref None +let module_resolution_flag : module_resolution option ref = ref None +let export_interfaces_flag = ref false +let generated_file_extension_flag : string option ref = ref None +let suffix_flag : string option ref = ref None +let shims : (string * string) list ref = ref [] +let bs_dependencies_flag : string list ref = ref [] +let source_dirs_flag : string list ref = ref [] + +let module_of_string = function + | "commonjs" -> Some CommonJS + | "esmodule" -> Some ESModule | _ -> None -let get_string_option s map = - match map |> get_opt s with - | Some (Str {str}) -> Some str +let module_resolution_of_string = function + | "node" -> Some Node + | "node16" -> Some Node16 + | "bundler" -> Some Bundler | _ -> None -let get_shims map = - let shims = ref [] in - (match map |> get_opt "shims" with - | Some (Obj {map = shims_map}) -> - Map_string.iter shims_map (fun from_module to_module -> - match to_module with - | Ext_json_types.Str {str} -> shims := (from_module, str) :: !shims - | _ -> ()) - | Some (Arr {content}) -> - (* To be deprecated: array of strings *) - content - |> Array.iter (fun x -> - match x with - | Ext_json_types.Str {str} -> - let from_to = str |> String.split_on_char '=' |> Array.of_list in - assert (Array.length from_to == 2); - shims := - ((from_to.(0) [@doesNotRaise]), (from_to.(1) [@doesNotRaise])) - :: !shims - | _ -> ()) - | _ -> ()); - !shims - -let set_debug ~gtconf = - match gtconf |> get_opt "debug" with - | Some (Obj {map}) -> Map_string.iter map Debug.set_item +let add_shim raw = + match String.split_on_char '=' raw with + | [from_module; to_module] -> shims := (from_module, to_module) :: !shims | _ -> () -let compiler_config_file = "rescript.json" - -let rec find_project_root ~dir = - if Sys.file_exists (Filename.concat dir compiler_config_file) then dir - else - let parent = dir |> Filename.dirname in - if parent = dir then ( - prerr_endline - ("Error: cannot find project root containing " ^ compiler_config_file - ^ "."); - assert false) - else find_project_root ~dir:parent - -let read_config ~get_config_file ~namespace = - let project_root = find_project_root ~dir:(Sys.getcwd ()) in +let add_bs_dependency name = + bs_dependencies_flag := name :: !bs_dependencies_flag + +let add_source_dir dir = source_dirs_flag := dir :: !source_dirs_flag + +(* ----- Build the Config.t from flags ---------------------------------- *) + +let build_config ~namespace = + let shims_map = + !shims + |> List.fold_left + (fun map (from_module, to_module) -> + let module_name = + (from_module |> ModuleName.from_string_unsafe : ModuleName.t) + in + let shim_module_name = to_module |> ModuleName.from_string_unsafe in + ModuleNameMap.add module_name shim_module_name map) + ModuleNameMap.empty + in + let project_root = + match !project_root with + | "" -> Sys.getcwd () + | dir -> dir + in let bsb_project_root = - match Sys.getenv_opt "BSB_PROJECT_ROOT" with - | None -> project_root - | Some s -> s + match !bsb_project_root with + | "" -> project_root + | dir -> dir + in + let module_ = + match !module_flag with + | Some m -> m + | None -> default.module_ in - let parse_config ~bsconf ~gtconf = - let module_string = gtconf |> get_string_option "module" in - let module_resolution_string = - gtconf |> get_string_option "moduleResolution" - in - let export_interfaces_bool = gtconf |> get_bool "exportInterfaces" in - let generated_file_extension_string_option = - gtconf |> get_string_option "generatedFileExtension" - in - let shims_map = - gtconf |> get_shims - |> List.fold_left - (fun map (from_module, to_module) -> - let module_name = - (from_module |> ModuleName.from_string_unsafe : ModuleName.t) - in - let shim_module_name = - to_module |> ModuleName.from_string_unsafe - in - ModuleNameMap.add module_name shim_module_name map) - ModuleNameMap.empty - in - set_debug ~gtconf; - let module_ = - let package_specs_module_string = - match bsconf |> get_opt "package-specs" with - | Some (Obj {map = package_specs}) -> - package_specs |> get_string_option "module" - | _ -> None - in - (* Give priority to gentypeconfig, followed by package-specs *) - match (module_string, package_specs_module_string) with - | Some "commonjs", _ -> CommonJS - | Some "esmodule", _ -> ESModule - | None, Some "commonjs" -> CommonJS - | None, Some "esmodule" -> ESModule - | _ -> default.module_ - in - let module_resolution = - match module_resolution_string with - | Some "node" -> Node - | Some "node16" -> Node16 - | Some "bundler" -> Bundler - | _ -> default.module_resolution - in - let export_interfaces = - match export_interfaces_bool with - | None -> default.export_interfaces - | Some b -> b - in - let generated_file_extension = generated_file_extension_string_option in - let platform_lib = "rescript" in - if !Debug.config then ( - Log_.item "Project root: %s\n" project_root; - if bsb_project_root <> project_root then - Log_.item "bsb project root: %s\n" bsb_project_root; - Log_.item "Config module:%s shims:%d entries \n" - (match module_string with - | None -> "" - | Some s -> s) - (shims_map |> ModuleNameMap.cardinal)); - let namespace = - match bsconf |> get_opt "namespace" with - | Some (True _) -> namespace - | _ -> default.namespace - in - let suffix = - match bsconf |> get_string_option "suffix" with - | Some s -> s - | _ -> default.suffix - in - let bs_dependencies = - match bsconf |> get_opt "dependencies" with - | Some (Arr {content}) -> - let strings = ref [] in - content - |> Array.iter (fun x -> - match x with - | Ext_json_types.Str {str} -> strings := str :: !strings - | _ -> ()); - !strings - | _ -> default.bs_dependencies - in - let sources = - match bsconf |> get_opt "sources" with - | Some source_item -> Some source_item - | _ -> default.sources - in - let everything = false in - { - bsb_project_root; - bs_dependencies; - suffix; - emit_import_curry = false; - emit_import_react = false; - emit_type_prop_done = false; - everything; - export_interfaces; - generated_file_extension; - module_; - module_resolution; - namespace; - platform_lib; - project_root; - shims_map; - sources; - } + let module_resolution = + match !module_resolution_flag with + | Some r -> r + | None -> default.module_resolution in - let default_config = {default with project_root; bsb_project_root} in - match get_config_file ~project_root with - | Some config_file -> ( - try - let json = config_file |> Ext_json_parse.parse_json_from_file in - match json with - | Obj {map = bsconf} -> ( - match bsconf |> get_opt "gentypeconfig" with - | Some (Obj {map = gtconf}) -> parse_config ~bsconf ~gtconf - | _ -> default_config) - | _ -> default_config - with _ -> default_config) - | None -> default_config + let suffix = + match !suffix_flag with + | Some s -> s + | None -> default.suffix + in + if !Debug.config then ( + Log_.item "Project root: %s\n" project_root; + if bsb_project_root <> project_root then + Log_.item "bsb project root: %s\n" bsb_project_root; + Log_.item "Config shims:%d entries \n" (shims_map |> ModuleNameMap.cardinal)); + { + bsb_project_root; + bs_dependencies = List.rev !bs_dependencies_flag; + emit_import_curry = false; + emit_import_react = false; + emit_type_prop_done = false; + everything = false; + export_interfaces = !export_interfaces_flag; + generated_file_extension = !generated_file_extension_flag; + module_; + module_resolution; + namespace; + platform_lib = "rescript"; + project_root; + shims_map; + sources = List.rev !source_dirs_flag; + suffix; + } diff --git a/compiler/gentype/ModuleResolver.ml b/compiler/gentype/ModuleResolver.ml index 3adba146eea..12eeb63bd10 100644 --- a/compiler/gentype/ModuleResolver.ml +++ b/compiler/gentype/ModuleResolver.ml @@ -21,43 +21,20 @@ let read_bs_dependencies_dirs ~root = type pkgs = {dirs: string list; pkgs: (string, string) Hashtbl.t} +(** Source directories are pre-expanded by the build system and supplied via + [-bs-gentype-source-dir] flags — we just filter to the ones that actually + exist on disk under the project root. *) let read_dirs_from_config ~(config : Config.t) = - let dirs = ref [] in - let root = config.project_root in let ( +++ ) = Filename.concat in - let rec process_dir ~subdirs dir = - let abs_dir = - match dir = "" with - | true -> root - | false -> root +++ dir - in - if Sys.file_exists abs_dir && Sys.is_directory abs_dir then ( - dirs := dir :: !dirs; - if subdirs then - abs_dir |> Sys.readdir - |> Array.iter (fun d -> process_dir ~subdirs (dir +++ d))) - in - let rec process_source_item (source_item : Ext_json_types.t) = - match source_item with - | Str {str} -> str |> process_dir ~subdirs:false - | Obj {map} -> ( - match Map_string.find_opt map "dir" with - | Some (Str {str}) -> - let subdirs = - match Map_string.find_opt map "subdirs" with - | Some (True _) -> true - | Some (False _) -> false - | _ -> false - in - str |> process_dir ~subdirs - | _ -> ()) - | Arr {content} -> Array.iter process_source_item content - | _ -> () - in - (match config.sources with - | Some source_item -> process_source_item source_item - | None -> ()); - !dirs + let root = config.project_root in + config.sources + |> List.filter (fun dir -> + let abs_dir = + match dir = "" with + | true -> root + | false -> root +++ dir + in + Sys.file_exists abs_dir && Sys.is_directory abs_dir) let read_source_dirs ~(config : Config.t) = let source_dirs = diff --git a/compiler/gentype/Paths.ml b/compiler/gentype/Paths.ml index d6dae2282f6..c1407ae499b 100644 --- a/compiler/gentype/Paths.ml +++ b/compiler/gentype/Paths.ml @@ -85,10 +85,4 @@ let get_cmt_file cmt = in cmt_file -let get_config_file ~project_root = - let config = concat project_root Config.compiler_config_file in - match config |> Sys.file_exists with - | true -> Some config - | false -> None - -let read_config ~namespace = Config.read_config ~get_config_file ~namespace +let read_config ~namespace = Config.build_config ~namespace diff --git a/rewatch/src/build.rs b/rewatch/src/build.rs index f85a911e12a..afb6db6eb2e 100644 --- a/rewatch/src/build.rs +++ b/rewatch/src/build.rs @@ -103,6 +103,7 @@ pub fn get_compiler_args(rescript_file_path: &Path) -> Result { is_type_dev, true, None, // No warn_error_override for compiler-args command + &[], // Source dirs not available outside full build; gentype falls back to defaults. )?; let result = serde_json::to_string_pretty(&CompilerArgs { diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index 87bf58c5dd4..8244adb6c43 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -472,6 +472,56 @@ pub fn compile( Ok((compile_errors, compile_warnings, num_compiled_modules)) } +/// Walks a package's declared source folders and returns every directory +/// reachable under them (honoring `subdirs: true`), relative to the package +/// root. Mirrors the filesystem walk gentype used to perform from +/// `rescript.json` when resolving cross-file imports. +fn collect_gentype_source_dirs(package: &packages::Package) -> Vec { + let mut out: Vec = Vec::new(); + let root = &package.path; + + fn walk_recursive(root: &Path, rel: &Path, out: &mut Vec) { + let abs = if rel.as_os_str().is_empty() { + root.to_path_buf() + } else { + root.join(rel) + }; + let Ok(meta) = std::fs::metadata(&abs) else { + return; + }; + if !meta.is_dir() { + return; + } + out.push(rel.to_path_buf()); + let Ok(entries) = std::fs::read_dir(&abs) else { + return; + }; + for entry in entries.flatten() { + let Ok(child_meta) = entry.metadata() else { + continue; + }; + if child_meta.is_dir() { + let name = entry.file_name(); + walk_recursive(root, &rel.join(name), out); + } + } + } + + for source in &package.source_folders { + let rel = PathBuf::from(&source.dir); + match &source.subdirs { + Some(config::Subdirs::Recurse(true)) => walk_recursive(root, &rel, &mut out), + _ => { + let abs = root.join(&rel); + if abs.is_dir() { + out.push(rel); + } + } + } + } + out +} + static RUNTIME_PATH_MEMO: OnceLock = OnceLock::new(); pub fn get_runtime_path(package_config: &Config, project_context: &ProjectContext) -> Result { @@ -520,6 +570,9 @@ pub fn compiler_args( is_local_dep: bool, // Command-line --warn-error flag override (takes precedence over rescript.json config) warn_error_override: Option, + // Pre-expanded source directories for the current package (used by gentype). + // Pass an empty slice when unavailable (e.g. the compiler-args CLI command). + current_package_dirs: &[PathBuf], ) -> Result> { let bsc_flags = config::flatten_flags(&config.compiler_flags); let dependency_paths = get_dependency_paths(config, project_context, packages, is_type_dev); @@ -551,7 +604,8 @@ pub fn compiler_args( let jsx_module_args = root_config.get_jsx_module_args(); let jsx_mode_args = root_config.get_jsx_mode_args(); let jsx_preserve_args = root_config.get_jsx_preserve_args(); - let gentype_arg = config.get_gentype_arg(); + let bsb_project_root = project_context.get_root_path(); + let gentype_arg = config.get_gentype_args(current_package_dirs, Some(bsb_project_root)); let experimental_args = root_config.get_experimental_features_args(); let warning_args = config.get_warning_args(is_local_dep, warn_error_override); @@ -755,6 +809,14 @@ fn compile_file( helpers::file_path_to_compiler_asset_basename(implementation_file_path, &package.namespace); let has_interface = module.get_interface().is_some(); let is_type_dev = module.is_type_dev; + // Gentype resolves cross-file imports by walking every directory reachable + // from the sources tree (including dirs that hold only `.ts` shims), + // so we can't rely on `package.dirs` which only tracks `.res` dirs. + let current_package_dirs: Vec = if package.config.gentype_config.is_some() { + collect_gentype_source_dirs(package) + } else { + Vec::new() + }; let to_mjs_args = compiler_args( &package.config, ast_path, @@ -766,6 +828,7 @@ fn compile_file( is_type_dev, package.is_local_dep, warn_error_override, + ¤t_package_dirs, )?; let to_mjs = Command::new(&compiler_info.bsc_path) diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 921e207980b..5d1edcd51e9 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -233,8 +233,123 @@ pub struct JsxSpecs { pub preserve: Option, } -/// We do not care about the internal structure because the gentype config is loaded by bsc. -pub type GenTypeConfig = serde_json::Value; +#[derive(Debug, Clone, PartialEq, Eq)] +pub enum GenTypeModule { + CommonJs, + EsModule, +} + +impl GenTypeModule { + pub fn as_str(&self) -> &'static str { + match self { + GenTypeModule::CommonJs => "commonjs", + GenTypeModule::EsModule => "esmodule", + } + } +} + +impl<'de> Deserialize<'de> for GenTypeModule { + fn deserialize(deserializer: D) -> Result + where + D: Deserializer<'de>, + { + let raw = String::deserialize(deserializer)?; + match raw.as_str() { + "commonjs" => Ok(GenTypeModule::CommonJs), + "esmodule" => Ok(GenTypeModule::EsModule), + other => Err(DeError::custom(format!( + "Unknown gentypeconfig.module value '{other}'. Expected: commonjs | esmodule", + ))), + } + } +} + +#[derive(Debug, Clone, PartialEq, Eq)] +pub enum GenTypeModuleResolution { + Node, + Node16, + Bundler, +} + +impl GenTypeModuleResolution { + pub fn as_str(&self) -> &'static str { + match self { + GenTypeModuleResolution::Node => "node", + GenTypeModuleResolution::Node16 => "node16", + GenTypeModuleResolution::Bundler => "bundler", + } + } +} + +impl<'de> Deserialize<'de> for GenTypeModuleResolution { + fn deserialize(deserializer: D) -> Result + where + D: Deserializer<'de>, + { + let raw = String::deserialize(deserializer)?; + match raw.as_str() { + "node" => Ok(GenTypeModuleResolution::Node), + "node16" => Ok(GenTypeModuleResolution::Node16), + "bundler" => Ok(GenTypeModuleResolution::Bundler), + other => Err(DeError::custom(format!( + "Unknown gentypeconfig.moduleResolution value '{other}'. Expected: node | node16 | bundler", + ))), + } + } +} + +/// Accepts either an object `{ "From": "To", ... }` or (deprecated) an array of +/// `"From=To"` strings. +#[derive(Debug, Clone, PartialEq, Eq, Default)] +pub struct GenTypeShims(pub HashMap); + +impl<'de> Deserialize<'de> for GenTypeShims { + fn deserialize(deserializer: D) -> Result + where + D: Deserializer<'de>, + { + #[derive(Deserialize)] + #[serde(untagged)] + enum Repr { + Map(HashMap), + List(Vec), + } + match Repr::deserialize(deserializer)? { + Repr::Map(m) => Ok(GenTypeShims(m)), + Repr::List(entries) => { + let mut map = HashMap::with_capacity(entries.len()); + for entry in entries { + match entry.split_once('=') { + Some((from, to)) => { + map.insert(from.trim().to_string(), to.trim().to_string()); + } + None => { + return Err(DeError::custom(format!( + "Invalid gentypeconfig.shims entry '{entry}': expected 'From=To'", + ))); + } + } + } + Ok(GenTypeShims(map)) + } + } + } +} + +#[derive(Deserialize, Debug, Clone, PartialEq, Eq, Default)] +pub struct GenTypeConfig { + pub module: Option, + #[serde(rename = "moduleResolution")] + pub module_resolution: Option, + #[serde(rename = "exportInterfaces")] + pub export_interfaces: Option, + #[serde(rename = "generatedFileExtension")] + pub generated_file_extension: Option, + #[serde(default)] + pub shims: GenTypeShims, + #[serde(default)] + pub debug: HashMap, +} /// Configuration for running a command after each JavaScript file is compiled. /// Note: Unlike bsb, rewatch passes absolute paths to the command for clarity. @@ -598,11 +713,64 @@ impl Config { } } - pub fn get_gentype_arg(&self) -> Vec { - match &self.gentype_config { - Some(_) => vec!["-bs-gentype".to_string()], - None => vec![], + /// Build the full set of `-bs-gentype-*` CLI flags for a bsc invocation. + /// `source_dirs` are pre-expanded directories relative to the package root. + pub fn get_gentype_args(&self, source_dirs: &[PathBuf], bsb_project_root: Option<&Path>) -> Vec { + let Some(gt) = &self.gentype_config else { + return vec![]; + }; + let mut args = vec!["-bs-gentype".to_string()]; + + if let Some(module) = >.module { + args.push("-bs-gentype-module".to_string()); + args.push(module.as_str().to_string()); + } + if let Some(resolution) = >.module_resolution { + args.push("-bs-gentype-module-resolution".to_string()); + args.push(resolution.as_str().to_string()); + } + if gt.export_interfaces == Some(true) { + args.push("-bs-gentype-export-interfaces".to_string()); + } + if let Some(ext) = >.generated_file_extension { + args.push("-bs-gentype-generated-extension".to_string()); + args.push(ext.clone()); + } + if let Some(suffix) = &self.suffix { + args.push("-bs-gentype-suffix".to_string()); + args.push(suffix.clone()); } + let mut shims: Vec<(&String, &String)> = gt.shims.0.iter().collect(); + shims.sort_by(|a, b| a.0.cmp(b.0)); + for (from_, to) in shims { + args.push("-bs-gentype-shim".to_string()); + args.push(format!("{from_}={to}")); + } + let mut debug_items: Vec<&String> = gt + .debug + .iter() + .filter_map(|(k, v)| if *v { Some(k) } else { None }) + .collect(); + debug_items.sort(); + for item in debug_items { + args.push("-bs-gentype-debug".to_string()); + args.push(item.clone()); + } + if let Some(deps) = &self.dependencies { + for dep in deps { + args.push("-bs-gentype-dep".to_string()); + args.push(dep.clone()); + } + } + for dir in source_dirs { + args.push("-bs-gentype-source-dir".to_string()); + args.push(dir.to_string_lossy().to_string()); + } + if let Some(root) = bsb_project_root { + args.push("-bs-gentype-bsb-project-root".to_string()); + args.push(root.to_string_lossy().to_string()); + } + args } /// Directory containing the `rescript.json` this config was parsed from. @@ -1033,8 +1201,42 @@ pub mod tests { "#; let config = serde_json::from_str::(json).unwrap(); - assert!(config.gentype_config.is_some()); - assert_eq!(config.get_gentype_arg(), vec!["-bs-gentype".to_string()]); + let gt = config.gentype_config.as_ref().unwrap(); + assert_eq!(gt.module, Some(GenTypeModule::EsModule)); + assert_eq!(gt.generated_file_extension.as_deref(), Some(".gen.tsx")); + + let args = config.get_gentype_args(&[], None); + assert!(args.contains(&"-bs-gentype".to_string())); + assert!(args.contains(&"-bs-gentype-module".to_string())); + assert!(args.contains(&"esmodule".to_string())); + assert!(args.contains(&"-bs-gentype-generated-extension".to_string())); + assert!(args.contains(&".gen.tsx".to_string())); + assert!(args.contains(&"-bs-gentype-suffix".to_string())); + assert!(args.contains(&".mjs".to_string())); + assert!(args.contains(&"-bs-gentype-dep".to_string())); + assert!(args.contains(&"@teamwalnut/app".to_string())); + } + + #[test] + fn test_gentype_shims_object_and_array_forms() { + let object_form = serde_json::from_str::(r#"{"From": "To"}"#).unwrap(); + assert_eq!(object_form.0.get("From"), Some(&"To".to_string())); + + let array_form = serde_json::from_str::(r#"["From=To", "A=B"]"#).unwrap(); + assert_eq!(array_form.0.get("From"), Some(&"To".to_string())); + assert_eq!(array_form.0.get("A"), Some(&"B".to_string())); + } + + #[test] + fn test_gentype_args_without_gentype_config() { + let json = r#" + { + "name": "pkg", + "sources": [ { "dir": "src/", "subdirs": true } ] + } + "#; + let config = serde_json::from_str::(json).unwrap(); + assert!(config.get_gentype_args(&[], None).is_empty()); } #[test] From 9d737f518ec061894e114a9d5584e7828ed67cb5 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 10:59:53 +0200 Subject: [PATCH 03/13] Delete rescript.json filesystem walk from the OCaml compiler With rewatch always passing -bs-project-root, the fallback walk in Ext_path.find_root_filename was only reachable from direct bsc invocations. Move that walk to the Node.js wrapper (cli/bsc.js), which auto-injects -bs-project-root when absent, and make Ext_path.package_dir fail loudly if the flag was never set. - Ext_path: drop find_root_filename, find_config_dir, fallback_package_dir. package_dir () now errors out with a clear message if custom_package_dir is None. - Literals.rescript_json: removed (last reference was the deleted walk). - cli/bsc.js: walk up from cwd for rescript.json, append -bs-project-root to the args when it isn't already there. The compiler now has zero code paths that read or locate rescript.json. Locating the project root is a concern entirely for the build system (rewatch) or the JS wrapper. Co-Authored-By: Claude Opus 4.7 (1M context) --- cli/bsc.js | 26 ++++++++++++++++++++++++++ compiler/ext/ext_path.ml | 30 ++++++++---------------------- compiler/ext/ext_path.mli | 8 ++++---- compiler/ext/literals.ml | 2 -- 4 files changed, 38 insertions(+), 28 deletions(-) diff --git a/cli/bsc.js b/cli/bsc.js index 44d3f4ac414..e6b0965dd05 100755 --- a/cli/bsc.js +++ b/cli/bsc.js @@ -3,14 +3,40 @@ // @ts-check import { execFileSync } from "node:child_process"; +import { existsSync } from "node:fs"; +import { dirname, join } from "node:path"; import { bsc_exe } from "./common/bins.js"; import { runtimePath } from "./common/runtime.js"; +/** + * Walk up from `startDir` until a directory containing `rescript.json` + * is found. Returns null if none is found. + * @param {string} startDir + * @returns {string | null} + */ +function findProjectRoot(startDir) { + let dir = startDir; + while (true) { + if (existsSync(join(dir, "rescript.json"))) { + return dir; + } + const parent = dirname(dir); + if (parent === dir) return null; + dir = parent; + } +} + const delegate_args = process.argv.slice(2); if (!delegate_args.includes("-runtime-path")) { delegate_args.push("-runtime-path", runtimePath); } +if (!delegate_args.includes("-bs-project-root")) { + const projectRoot = findProjectRoot(process.cwd()); + if (projectRoot !== null) { + delegate_args.push("-bs-project-root", projectRoot); + } +} try { execFileSync(bsc_exe, delegate_args, { stdio: "inherit" }); diff --git a/compiler/ext/ext_path.ml b/compiler/ext/ext_path.ml index 0f04895895e..629e11aeb0f 100644 --- a/compiler/ext/ext_path.ml +++ b/compiler/ext/ext_path.ml @@ -110,30 +110,16 @@ let absolute_cwd_path s = absolute_path cwd s | File x -> File (absolute_path cwd x ) | Dir x -> Dir (absolute_path cwd x) *) -(* Input must be absolute directory *) -let rec find_root_filename ~cwd filenames = - let file_exists = - Ext_list.exists filenames (fun filename -> - Sys.file_exists (Filename.concat cwd filename)) - in - if file_exists then cwd - else - let cwd' = Filename.dirname cwd in - if String.length cwd' < String.length cwd then - find_root_filename ~cwd:cwd' filenames - else - Ext_fmt.failwithf ~loc:__LOC__ "%s not found from %s" (List.hd filenames) - cwd - -let find_config_dir cwd = find_root_filename ~cwd [Literals.rescript_json] - -(* When set (e.g. by the build system via -bs-project-root), we skip the - directory walk entirely. *) +(** Set by [-bs-project-root] to tell the compiler where the package root is. + The build system (rewatch) or [cli/bsc.js] is responsible for supplying it; + the compiler no longer reads [rescript.json] itself. *) let custom_package_dir : string option ref = ref None -let fallback_package_dir = lazy (find_config_dir (Lazy.force cwd)) - let package_dir () = match !custom_package_dir with | Some dir -> dir - | None -> Lazy.force fallback_package_dir + | None -> + Ext_fmt.failwithf ~loc:__LOC__ + "bsc was invoked without -bs-project-root; cannot determine the package \ + root. Pass -bs-project-root or invoke bsc via rewatch / \ + cli/bsc.js." diff --git a/compiler/ext/ext_path.mli b/compiler/ext/ext_path.mli index e68eae360d0..579e0448625 100644 --- a/compiler/ext/ext_path.mli +++ b/compiler/ext/ext_path.mli @@ -30,9 +30,9 @@ val node_rebase_file : from:string -> to_:string -> string -> string val absolute_cwd_path : string -> string val custom_package_dir : string option ref -(** When set, [package_dir ()] returns this value instead of walking the - filesystem. Typically set by the build system via [-bs-project-root]. *) +(** Set by [-bs-project-root]. Must be populated before [package_dir ()] is + called; the compiler does not locate [rescript.json] on its own. *) val package_dir : unit -> string -(** Returns the package root directory. Evaluated on demand so that script - mode does not hit the filesystem walk when [custom_package_dir] is unset. *) +(** Returns the package root directory. Fails if [custom_package_dir] is + unset. *) diff --git a/compiler/ext/literals.ml b/compiler/ext/literals.ml index ecc2fff3cde..884a1934b90 100644 --- a/compiler/ext/literals.ml +++ b/compiler/ext/literals.ml @@ -72,8 +72,6 @@ let node_modules_length = String.length "node_modules" let package_json = "package.json" -let rescript_json = "rescript.json" - (* Name of the library file created for each external dependency. *) let library_file = "lib" From faa54347655e435b0a4e8afc42b607b61e65eb89 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 11:20:36 +0200 Subject: [PATCH 04/13] Remove the custom Ext_json parser MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three sites still used compiler/ext/ext_json* after the rescript.json removal: gentype's .sourcedirs.json reader, reanalyze's cmt-scan reader, and the parser's own ounit test suite. Each is handled separately so the custom lexer-based parser can be deleted outright. Gentype: - Add -bs-gentype-dep-path = flag. rewatch emits one per dependency, resolved through the packages map it already holds. - GenTypeConfig.Config.t gains a dep_paths Hashtbl populated from the flags. ModuleResolver.sourcedirs_to_map now reads from config.sources + config.dep_paths instead of opening /lib/bs/ .sourcedirs.json. The missing-.sourcedirs.json warning and the read_dirs_from_config fallback are gone — rewatch supplies both pieces directly. Reanalyze: - Delete dead readSourceDirs and readDirsFromConfig (no callers). - Port readCmtScan from Ext_json_parse to jsonlib (Json.parse), which reanalyze already depends on for its rescript.json reading. - Drop `ext` from reanalyze's dune libraries. Parser: - Delete ext_json.ml/mli, ext_json_parse.mll/mli, ext_json_noloc.ml/ mli, ext_json_types.ml. - Delete the ocamllex rule in compiler/ext/dune. - Delete ounit_ext_json_tests.ml and its registration in ounit_tests_main.ml. Net: -1006 lines. No code anywhere in the repo parses JSON with the custom lexer now; jsonlib is the only JSON parser left. Generated .gen.tsx / .bs.js output is byte-identical; make test, test-gentype, and test-rewatch all pass. Co-Authored-By: Claude Opus 4.7 (1M context) --- analysis/reanalyze/src/Paths.ml | 147 ++------- analysis/reanalyze/src/dune | 2 +- compiler/bsc/rescript_compiler_main.ml | 4 + compiler/ext/dune | 2 - compiler/ext/ext_json.ml | 71 ----- compiler/ext/ext_json.mli | 50 --- compiler/ext/ext_json_noloc.ml | 126 -------- compiler/ext/ext_json_noloc.mli | 54 ---- compiler/ext/ext_json_parse.mli | 35 --- compiler/ext/ext_json_parse.mll | 351 ---------------------- compiler/ext/ext_json_types.ml | 42 --- compiler/gentype/GenTypeConfig.ml | 16 + compiler/gentype/ModuleResolver.ml | 90 +----- rewatch/src/build/compile.rs | 15 +- rewatch/src/config.rs | 17 +- tests/ounit_tests/ounit_ext_json_tests.ml | 153 ---------- tests/ounit_tests/ounit_tests_main.ml | 1 - tests/ounit_tests/ounit_vec_test.ml | 2 - 18 files changed, 86 insertions(+), 1092 deletions(-) delete mode 100644 compiler/ext/ext_json.ml delete mode 100644 compiler/ext/ext_json.mli delete mode 100644 compiler/ext/ext_json_noloc.ml delete mode 100644 compiler/ext/ext_json_noloc.mli delete mode 100644 compiler/ext/ext_json_parse.mli delete mode 100644 compiler/ext/ext_json_parse.mll delete mode 100644 compiler/ext/ext_json_types.ml delete mode 100644 tests/ounit_tests/ounit_ext_json_tests.ml diff --git a/analysis/reanalyze/src/Paths.ml b/analysis/reanalyze/src/Paths.ml index 05b17cefd0a..8e0f51ef7a4 100644 --- a/analysis/reanalyze/src/Paths.ml +++ b/analysis/reanalyze/src/Paths.ml @@ -1,5 +1,3 @@ -module StringMap = Map_string - let rescriptJson = "rescript.json" let readFile filename = @@ -127,79 +125,6 @@ let handleNamespace cmt = let getModuleName cmt = cmt |> handleNamespace |> Filename.basename -let readDirsFromConfig ~configSources = - let dirs = ref [] in - let root = runConfig.projectRoot in - let rec processDir ~subdirs dir = - let absDir = - match dir = "" with - | true -> root - | false -> Filename.concat root dir - in - if Sys.file_exists absDir && Sys.is_directory absDir then ( - dirs := dir :: !dirs; - if subdirs then - absDir |> Sys.readdir - |> Array.iter (fun d -> processDir ~subdirs (Filename.concat dir d))) - in - let rec processSourceItem (sourceItem : Ext_json_types.t) = - match sourceItem with - | Str {str} -> str |> processDir ~subdirs:false - | Obj {map} -> ( - match StringMap.find_opt map "dir" with - | Some (Str {str}) -> - let subdirs = - match StringMap.find_opt map "subdirs" with - | Some (True _) -> true - | Some (False _) -> false - | _ -> false - in - str |> processDir ~subdirs - | _ -> ()) - | Arr {content = arr} -> arr |> Array.iter processSourceItem - | _ -> () - in - (match configSources with - | Some sourceItem -> processSourceItem sourceItem - | None -> ()); - !dirs - -let readSourceDirs ~configSources = - let sourceDirs = - ["lib"; "bs"; ".sourcedirs.json"] - |> List.fold_left Filename.concat runConfig.bsbProjectRoot - in - let dirs = ref [] in - let readDirs json = - match json with - | Ext_json_types.Obj {map} -> ( - match StringMap.find_opt map "dirs" with - | Some (Arr {content = arr}) -> - arr - |> Array.iter (fun x -> - match x with - | Ext_json_types.Str {str} -> dirs := str :: !dirs - | _ -> ()); - () - | _ -> ()) - | _ -> () - in - if sourceDirs |> Sys.file_exists then - let jsonOpt = sourceDirs |> Ext_json_parse.parse_json_from_file in - match jsonOpt with - | exception _ -> () - | json -> - if runConfig.bsbProjectRoot <> runConfig.projectRoot then ( - readDirs json; - dirs := readDirsFromConfig ~configSources) - else readDirs json - else ( - if !Cli.debug then ( - Log_.item "Warning: can't find source dirs: %s\n" sourceDirs; - Log_.item "Types for cross-references will not be found.\n"); - dirs := readDirsFromConfig ~configSources); - !dirs - type cmt_scan_entry = { build_root: string; scan_dirs: string list; @@ -220,51 +145,31 @@ let readCmtScan () = ["lib"; "bs"; ".sourcedirs.json"] |> List.fold_left Filename.concat runConfig.bsbProjectRoot in - let entries = ref [] in - let read_entry (json : Ext_json_types.t) = - match json with - | Ext_json_types.Obj {map} -> ( - let build_root = - match StringMap.find_opt map "build_root" with - | Some (Ext_json_types.Str {str}) -> Some str - | _ -> None - in - let scan_dirs = - match StringMap.find_opt map "scan_dirs" with - | Some (Ext_json_types.Arr {content = arr}) -> - arr |> Array.to_list - |> List.filter_map (fun x -> - match x with - | Ext_json_types.Str {str} -> Some str - | _ -> None) - | _ -> [] - in - let also_scan_build_root = - match StringMap.find_opt map "also_scan_build_root" with - | Some (Ext_json_types.True _) -> true - | Some (Ext_json_types.False _) -> false - | _ -> false - in - match build_root with - | Some build_root -> - entries := {build_root; scan_dirs; also_scan_build_root} :: !entries - | None -> ()) - | _ -> () + let get key fn json = + Json.get key json |> Option.to_list |> List.filter_map fn in - let read_cmt_scan (json : Ext_json_types.t) = - match json with - | Ext_json_types.Obj {map} -> ( - match StringMap.find_opt map "cmt_scan" with - | Some (Ext_json_types.Arr {content = arr}) -> - arr |> Array.iter read_entry - | _ -> ()) - | _ -> () + let read_entry (json : Json.t) = + let build_root = json |> get "build_root" Json.string in + let scan_dirs = + match json |> get "scan_dirs" Json.array with + | [arr] -> arr |> List.filter_map Json.string + | _ -> [] + in + let also_scan_build_root = + match json |> get "also_scan_build_root" Json.bool with + | [b] -> b + | _ -> false + in + match build_root with + | [build_root] -> Some {build_root; scan_dirs; also_scan_build_root} + | _ -> None in - if sourceDirsFile |> Sys.file_exists then ( - let jsonOpt = sourceDirsFile |> Ext_json_parse.parse_json_from_file in - match jsonOpt with - | exception _ -> [] - | json -> - read_cmt_scan json; - !entries |> List.rev) - else [] + match readFile sourceDirsFile with + | None -> [] + | Some text -> ( + match Json.parse text with + | None -> [] + | Some json -> ( + match json |> get "cmt_scan" Json.array with + | [arr] -> arr |> List.filter_map read_entry + | _ -> [])) diff --git a/analysis/reanalyze/src/dune b/analysis/reanalyze/src/dune index 8431b0d52d5..3106987397f 100644 --- a/analysis/reanalyze/src/dune +++ b/analysis/reanalyze/src/dune @@ -2,4 +2,4 @@ (name reanalyze) (flags (-w "+6+26+27+32+33+39")) - (libraries reactive jsonlib ext ml str unix)) + (libraries reactive jsonlib ml str unix)) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index 46c8d0e1ee6..581f6d41860 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -334,6 +334,10 @@ let command_line_flags : (string * Bsc_args.spec * string) array = string_call GenTypeConfig.add_source_dir, "*internal* Register a gentype source directory relative to the project \ root (repeatable)" ); + ( "-bs-gentype-dep-path", + string_call GenTypeConfig.add_dep_path, + "*internal* Register a gentype dependency install path: \ + = (repeatable)" ); ( "-bs-gentype-bsb-project-root", string_call (fun s -> GenTypeConfig.bsb_project_root := s), "*internal* Set gentype bsb project root (workspace root containing \ diff --git a/compiler/ext/dune b/compiler/ext/dune index 0896ec2c27f..1e2117bcce8 100644 --- a/compiler/ext/dune +++ b/compiler/ext/dune @@ -15,8 +15,6 @@ (language c) (names ext_basic_hash_stubs))) -(ocamllex ext_json_parse) - (rule (targets hash_set_string.ml) (deps hash_set.cppo.ml) diff --git a/compiler/ext/ext_json.ml b/compiler/ext/ext_json.ml deleted file mode 100644 index 90915a2504b..00000000000 --- a/compiler/ext/ext_json.ml +++ /dev/null @@ -1,71 +0,0 @@ -(* 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 callback = - [ `Str of string -> unit - | `Str_loc of string -> Lexing.position -> unit - | `Flo of string -> unit - | `Flo_loc of string -> Lexing.position -> unit - | `Bool of bool -> unit - | `Obj of Ext_json_types.t Map_string.t -> unit - | `Arr of Ext_json_types.t array -> unit - | `Arr_loc of - Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit - | `Null of unit -> unit - | `Not_found of unit -> unit - | `Id of Ext_json_types.t -> unit ] - -type path = string list - -type status = No_path | Found of Ext_json_types.t | Wrong_type of path - -let test ?(fail = fun () -> ()) key (cb : callback) - (m : Ext_json_types.t Map_string.t) = - (match (Map_string.find_exn m key, cb) with - | exception Not_found -> ( - match cb with - | `Not_found f -> f () - | _ -> fail ()) - | True _, `Bool cb -> cb true - | False _, `Bool cb -> cb false - | Flo {flo = s}, `Flo cb -> cb s - | Flo {flo = s; loc}, `Flo_loc cb -> cb s loc - | Obj {map = b}, `Obj cb -> cb b - | Arr {content}, `Arr cb -> cb content - | Arr {content; loc_start; loc_end}, `Arr_loc cb -> - cb content loc_start loc_end - | Null _, `Null cb -> cb () - | Str {str = s}, `Str cb -> cb s - | Str {str = s; loc}, `Str_loc cb -> cb s loc - | any, `Id cb -> cb any - | _, _ -> fail ()); - m - -let loc_of (x : Ext_json_types.t) = - match x with - | True p | False p | Null p -> p - | Str p -> p.loc - | Arr p -> p.loc_start - | Obj p -> p.loc - | Flo p -> p.loc diff --git a/compiler/ext/ext_json.mli b/compiler/ext/ext_json.mli deleted file mode 100644 index 9e3935e5e38..00000000000 --- a/compiler/ext/ext_json.mli +++ /dev/null @@ -1,50 +0,0 @@ -(* 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 path = string list - -type status = No_path | Found of Ext_json_types.t | Wrong_type of path - -type callback = - [ `Str of string -> unit - | `Str_loc of string -> Lexing.position -> unit - | `Flo of string -> unit - | `Flo_loc of string -> Lexing.position -> unit - | `Bool of bool -> unit - | `Obj of Ext_json_types.t Map_string.t -> unit - | `Arr of Ext_json_types.t array -> unit - | `Arr_loc of - Ext_json_types.t array -> Lexing.position -> Lexing.position -> unit - | `Null of unit -> unit - | `Not_found of unit -> unit - | `Id of Ext_json_types.t -> unit ] - -val test : - ?fail:(unit -> unit) -> - string -> - callback -> - Ext_json_types.t Map_string.t -> - Ext_json_types.t Map_string.t - -val loc_of : Ext_json_types.t -> Ext_position.t diff --git a/compiler/ext/ext_json_noloc.ml b/compiler/ext/ext_json_noloc.ml deleted file mode 100644 index 3697a02226f..00000000000 --- a/compiler/ext/ext_json_noloc.ml +++ /dev/null @@ -1,126 +0,0 @@ -(* Copyright (C) 2017- Hongbo Zhang, Authors of ReScript - * - * 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 = - | True - | False - | Null - | Flo of string - | Str of string - | Arr of t array - | Obj of t Map_string.t - -(** poor man's serialization *) -let naive_escaped (text : string) : string = - let ln = String.length text in - let buf = Buffer.create ln in - let rec loop i = - if i < ln then ( - (match text.[i] with - | '\012' -> Buffer.add_string buf "\\f" - | '\\' -> Buffer.add_string buf "\\\\" - | '"' -> Buffer.add_string buf "\\\"" - | '\n' -> Buffer.add_string buf "\\n" - | '\b' -> Buffer.add_string buf "\\b" - | '\r' -> Buffer.add_string buf "\\r" - | '\t' -> Buffer.add_string buf "\\t" - | c -> - let code = Char.code c in - if code < 0x20 then Printf.bprintf buf "\\u%04x" code - else Buffer.add_char buf c); - loop (i + 1)) - in - loop 0; - Buffer.contents buf - -let quot x = "\"" ^ naive_escaped x ^ "\"" - -let true_ = True - -let false_ = False - -let null = Null - -let str s = Str s - -let flo s = Flo s - -let arr s = Arr s - -let obj s = Obj s - -let kvs s = Obj (Map_string.of_list s) - -let rec encode_buf (x : t) (buf : Buffer.t) : unit = - let a str = Buffer.add_string buf str in - match x with - | Null -> a "null" - | Str s -> a (quot s) - | Flo s -> - a s - (* - since our parsing keep the original float representation, we just dump it as is, there is no cases like [nan] *) - | Arr content -> ( - match content with - | [||] -> a "[]" - | _ -> - a "[ "; - encode_buf (Array.unsafe_get content 0) buf; - for i = 1 to Array.length content - 1 do - a " , "; - encode_buf (Array.unsafe_get content i) buf - done; - a " ]") - | True -> a "true" - | False -> a "false" - | Obj map -> - if Map_string.is_empty map then a "{}" - else ( - (*prerr_endline "WEIRD"; - prerr_endline (string_of_int @@ Map_string.cardinal map ); *) - a "{ "; - let (_ : int) = - Map_string.fold map 0 (fun k v i -> - if i <> 0 then a " , "; - a (quot k); - a " : "; - encode_buf v buf; - i + 1) - in - a " }") - -let to_string x = - let buf = Buffer.create 1024 in - encode_buf x buf; - Buffer.contents buf - -let to_channel (oc : out_channel) x = - let buf = Buffer.create 1024 in - encode_buf x buf; - Buffer.output_buffer oc buf - -let to_file name v = - let ochan = open_out_bin name in - to_channel ochan v; - close_out ochan diff --git a/compiler/ext/ext_json_noloc.mli b/compiler/ext/ext_json_noloc.mli deleted file mode 100644 index b6d8485f227..00000000000 --- a/compiler/ext/ext_json_noloc.mli +++ /dev/null @@ -1,54 +0,0 @@ -(* Copyright (C) 2017- Authors of ReScript - * - * 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 = private - | True - | False - | Null - | Flo of string - | Str of string - | Arr of t array - | Obj of t Map_string.t - -val true_ : t - -val false_ : t - -val null : t - -val str : string -> t - -val flo : string -> t - -val arr : t array -> t - -val obj : t Map_string.t -> t - -val kvs : (string * t) list -> t - -val to_string : t -> string - -val to_channel : out_channel -> t -> unit - -val to_file : string -> t -> unit diff --git a/compiler/ext/ext_json_parse.mli b/compiler/ext/ext_json_parse.mli deleted file mode 100644 index 2a23566e8fe..00000000000 --- a/compiler/ext/ext_json_parse.mli +++ /dev/null @@ -1,35 +0,0 @@ -(* 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 error - -val report_error : Format.formatter -> error -> unit - -exception Error of Lexing.position * Lexing.position * error - -val parse_json_from_string : string -> Ext_json_types.t - -val parse_json_from_chan : string -> in_channel -> Ext_json_types.t - -val parse_json_from_file : string -> Ext_json_types.t diff --git a/compiler/ext/ext_json_parse.mll b/compiler/ext/ext_json_parse.mll deleted file mode 100644 index 92f50feece7..00000000000 --- a/compiler/ext/ext_json_parse.mll +++ /dev/null @@ -1,351 +0,0 @@ -{ -type error = - | Illegal_character of char - | Unterminated_string - | Unterminated_comment - | Illegal_escape of string - | Unexpected_token - | Expect_comma_or_rbracket - | Expect_comma_or_rbrace - | Expect_colon - | Expect_string_or_rbrace - | Expect_eof - (* | Trailing_comma_in_obj *) - (* | Trailing_comma_in_array *) - - -let fprintf = Format.fprintf -let report_error ppf = function - | Illegal_character c -> - fprintf ppf "Illegal character (%s)" (Char.escaped c) - | Illegal_escape s -> - fprintf ppf "Illegal backslash escape in string or character (%s)" s - | Unterminated_string -> - fprintf ppf "Unterminated_string" - | Expect_comma_or_rbracket -> - fprintf ppf "Expect_comma_or_rbracket" - | Expect_comma_or_rbrace -> - fprintf ppf "Expect_comma_or_rbrace" - | Expect_colon -> - fprintf ppf "Expect_colon" - | Expect_string_or_rbrace -> - fprintf ppf "Expect_string_or_rbrace" - | Expect_eof -> - fprintf ppf "Expect_eof" - | Unexpected_token - -> - fprintf ppf "Unexpected_token" - (* | Trailing_comma_in_obj *) - (* -> fprintf ppf "Trailing_comma_in_obj" *) - (* | Trailing_comma_in_array *) - (* -> fprintf ppf "Trailing_comma_in_array" *) - | Unterminated_comment - -> fprintf ppf "Unterminated_comment" - - -exception Error of Lexing.position * Lexing.position * error - - -let () = - Printexc.register_printer - (function x -> - match x with - | Error (loc_start,loc_end,error) -> - Some (Format.asprintf - "@[%a:@ %a@ -@ %a)@]" - report_error error - Ext_position.print loc_start - Ext_position.print loc_end - ) - - | _ -> None - ) - - - - - -type token = - | Comma - | Eof - | False - | Lbrace - | Lbracket - | Null - | Colon - | Number of string - | Rbrace - | Rbracket - | String of string - | True - -let error (lexbuf : Lexing.lexbuf) e = - raise (Error (lexbuf.lex_start_p, lexbuf.lex_curr_p, e)) - - -let lexeme_len (x : Lexing.lexbuf) = - x.lex_curr_pos - x.lex_start_pos - -let update_loc (lexbuf : Lexing.lexbuf) diff = - let lex_curr_p = lexbuf.lex_curr_p in - lexbuf.lex_curr_p <- - { - lex_curr_p with - pos_lnum = lex_curr_p.pos_lnum + 1; - pos_bol = lex_curr_p.pos_cnum - diff; - } - -let char_for_backslash = function - | 'n' -> '\010' - | 'r' -> '\013' - | 'b' -> '\008' - | 't' -> '\009' - | c -> c - -let dec_code c1 c2 c3 = - 100 * (Char.code c1 - 48) + 10 * (Char.code c2 - 48) + (Char.code c3 - 48) - -let hex_code c1 c2 = - let d1 = Char.code c1 in - let val1 = - if d1 >= 97 then d1 - 87 - else if d1 >= 65 then d1 - 55 - else d1 - 48 in - let d2 = Char.code c2 in - let val2 = - if d2 >= 97 then d2 - 87 - else if d2 >= 65 then d2 - 55 - else d2 - 48 in - val1 * 16 + val2 - -let lf = '\010' -} - -let lf = '\010' -let lf_cr = ['\010' '\013'] -let dos_newline = "\013\010" -let blank = [' ' '\009' '\012'] - -let digit = ['0'-'9'] -let nonzero = ['1'-'9'] -let digits = digit + -let frac = '.' digits -let e = ['e' 'E']['+' '-']? -let exp = e digits -let positive_int = (digit | nonzero digits) -let number = '-'? positive_int (frac | exp | frac exp) ? -let hexdigit = digit | ['a'-'f' 'A'-'F'] - -let comment_start = "/*" -let comment_end = "*/" - -rule lex_json buf = parse -| blank + { lex_json buf lexbuf} -| lf | dos_newline { - update_loc lexbuf 0; - lex_json buf lexbuf - } -| comment_start { comment buf lexbuf} -| "true" { True} -| "false" {False} -| "null" {Null} -| "[" {Lbracket} -| "]" {Rbracket} -| "{" {Lbrace} -| "}" {Rbrace} -| "," {Comma} -| ':' {Colon} -| ("//" (_ # lf_cr)*) {lex_json buf lexbuf} - -| number { Number (Lexing.lexeme lexbuf)} - -| '"' { - let pos = Lexing.lexeme_start_p lexbuf in - scan_string buf pos lexbuf; - let content = (Buffer.contents buf) in - Buffer.clear buf ; - String content -} -| eof {Eof } -| _ as c { error lexbuf (Illegal_character c )} -and comment buf = parse -| comment_end {lex_json buf lexbuf} -| _ {comment buf lexbuf} -| eof {error lexbuf Unterminated_comment} -(* Note this is wrong for JSON conversion *) -(* We should fix it later *) -and scan_string buf start = parse -| '"' { () } -| '\\' lf [' ' '\t']* - { - let len = lexeme_len lexbuf - 2 in - update_loc lexbuf len; - - scan_string buf start lexbuf - } -| '\\' dos_newline [' ' '\t']* - { - let len = lexeme_len lexbuf - 3 in - update_loc lexbuf len; - scan_string buf start lexbuf - } -| '\\' (['\\' '\'' '"' 'n' 't' 'b' 'r' ' '] as c) - { - Buffer.add_char buf (char_for_backslash c); - scan_string buf start lexbuf - } -| '\\' (digit as c1) (digit as c2) (digit as c3) as s - { - let v = dec_code c1 c2 c3 in - if v > 255 then - error lexbuf (Illegal_escape s) ; - Buffer.add_char buf (Char.chr v); - - scan_string buf start lexbuf - } -| '\\' 'x' (hexdigit as c1) (hexdigit as c2) - { - let v = hex_code c1 c2 in - Buffer.add_char buf (Char.chr v); - - scan_string buf start lexbuf - } -| '\\' (_ as c) - { - Buffer.add_char buf '\\'; - Buffer.add_char buf c; - - scan_string buf start lexbuf - } -| lf - { - update_loc lexbuf 0; - Buffer.add_char buf lf; - - scan_string buf start lexbuf - } -| ([^ '\\' '"'] # lf)+ - { - let ofs = lexbuf.lex_start_pos in - let len = lexbuf.lex_curr_pos - ofs in - Buffer.add_subbytes buf lexbuf.lex_buffer ofs len; - - scan_string buf start lexbuf - } -| eof - { - error lexbuf Unterminated_string - } - -{ - - - - - - -let parse_json lexbuf = - let buf = Buffer.create 64 in - let look_ahead = ref None in - let token () : token = - match !look_ahead with - | None -> - lex_json buf lexbuf - | Some x -> - look_ahead := None ; - x - in - let push e = look_ahead := Some e in - let rec json (lexbuf : Lexing.lexbuf) : Ext_json_types.t = - match token () with - | True -> True lexbuf.lex_start_p - | False -> False lexbuf.lex_start_p - | Null -> Null lexbuf.lex_start_p - | Number s -> Flo {flo = s; loc = lexbuf.lex_start_p} - | String s -> Str { str = s; loc = lexbuf.lex_start_p} - | Lbracket -> parse_array lexbuf.lex_start_p lexbuf.lex_curr_p [] lexbuf - | Lbrace -> parse_map lexbuf.lex_start_p Map_string.empty lexbuf - | _ -> error lexbuf Unexpected_token - -(* Note if we remove [trailing_comma] support - we should report errors (actually more work), for example - {[ - match token () with - | Rbracket -> - if trailing_comma then - error lexbuf Trailing_comma_in_array - else - ]} - {[ - match token () with - | Rbrace -> - if trailing_comma then - error lexbuf Trailing_comma_in_obj - else - - ]} - *) - and parse_array loc_start loc_finish acc lexbuf - : Ext_json_types.t = - match token () with - | Rbracket -> - Arr {loc_start ; content = Ext_array.reverse_of_list acc ; - loc_end = lexbuf.lex_curr_p } - | x -> - push x ; - let new_one = json lexbuf in - begin match token () with - | Comma -> - parse_array loc_start loc_finish (new_one :: acc) lexbuf - | Rbracket - -> Arr {content = (Ext_array.reverse_of_list (new_one::acc)); - loc_start ; - loc_end = lexbuf.lex_curr_p } - | _ -> - error lexbuf Expect_comma_or_rbracket - end - and parse_map loc_start acc lexbuf : Ext_json_types.t = - match token () with - | Rbrace -> - Obj { map = acc ; loc = loc_start} - | String key -> - begin match token () with - | Colon -> - let value = json lexbuf in - begin match token () with - | Rbrace -> Obj {map = Map_string.add acc key value ; loc = loc_start} - | Comma -> - parse_map loc_start (Map_string.add acc key value ) lexbuf - | _ -> error lexbuf Expect_comma_or_rbrace - end - | _ -> error lexbuf Expect_colon - end - | _ -> error lexbuf Expect_string_or_rbrace - in - let v = json lexbuf in - match token () with - | Eof -> v - | _ -> error lexbuf Expect_eof - -let parse_json_from_string s = - parse_json (Lexing.from_string s ) - -let parse_json_from_chan fname in_chan = - let lexbuf = - Ext_position.lexbuf_from_channel_with_fname - in_chan fname in - parse_json lexbuf - -let parse_json_from_file s = - let in_chan = open_in s in - let lexbuf = - Ext_position.lexbuf_from_channel_with_fname - in_chan s in - match parse_json lexbuf with - | exception e -> close_in in_chan ; raise e - | v -> close_in in_chan; v - - - - -} diff --git a/compiler/ext/ext_json_types.ml b/compiler/ext/ext_json_types.ml deleted file mode 100644 index 3c338446802..00000000000 --- a/compiler/ext/ext_json_types.ml +++ /dev/null @@ -1,42 +0,0 @@ -(* Copyright (C) 2015-2017 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 loc = Lexing.position - -type json_str = {str: string; loc: loc} - -type json_flo = {flo: string; loc: loc} - -type json_array = {content: t array; loc_start: loc; loc_end: loc} - -and json_map = {map: t Map_string.t; loc: loc} - -and t = - | True of loc - | False of loc - | Null of loc - | Flo of json_flo - | Str of json_str - | Arr of json_array - | Obj of json_map diff --git a/compiler/gentype/GenTypeConfig.ml b/compiler/gentype/GenTypeConfig.ml index 1790871b274..deee28da3a9 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -15,6 +15,9 @@ type bs_version = int * int * int type t = { bsb_project_root: string; bs_dependencies: string list; + dep_paths: (string, string) Hashtbl.t; + (** Map from package name to its install path, used to locate + [.cmt]/[.cmti] files of cross-package references. *) mutable emit_import_curry: bool; mutable emit_import_react: bool; mutable emit_type_prop_done: bool; @@ -35,6 +38,7 @@ let default = { bsb_project_root = ""; bs_dependencies = []; + dep_paths = Hashtbl.create 0; emit_import_curry = false; emit_import_react = false; emit_type_prop_done = false; @@ -75,6 +79,7 @@ let suffix_flag : string option ref = ref None let shims : (string * string) list ref = ref [] let bs_dependencies_flag : string list ref = ref [] let source_dirs_flag : string list ref = ref [] +let dep_paths_flag : (string * string) list ref = ref [] let module_of_string = function | "commonjs" -> Some CommonJS @@ -97,6 +102,11 @@ let add_bs_dependency name = let add_source_dir dir = source_dirs_flag := dir :: !source_dirs_flag +let add_dep_path raw = + match String.split_on_char '=' raw with + | [name; path] -> dep_paths_flag := (name, path) :: !dep_paths_flag + | _ -> () + (* ----- Build the Config.t from flags ---------------------------------- *) let build_config ~namespace = @@ -141,9 +151,15 @@ let build_config ~namespace = if bsb_project_root <> project_root then Log_.item "bsb project root: %s\n" bsb_project_root; Log_.item "Config shims:%d entries \n" (shims_map |> ModuleNameMap.cardinal)); + let dep_paths = + let tbl = Hashtbl.create (List.length !dep_paths_flag) in + List.iter (fun (name, path) -> Hashtbl.add tbl name path) !dep_paths_flag; + tbl + in { bsb_project_root; bs_dependencies = List.rev !bs_dependencies_flag; + dep_paths; emit_import_curry = false; emit_import_react = false; emit_type_prop_done = false; diff --git a/compiler/gentype/ModuleResolver.ml b/compiler/gentype/ModuleResolver.ml index 12eeb63bd10..c52efa3dd74 100644 --- a/compiler/gentype/ModuleResolver.ml +++ b/compiler/gentype/ModuleResolver.ml @@ -19,78 +19,10 @@ let read_bs_dependencies_dirs ~root = find_sub_dirs ""; !dirs -type pkgs = {dirs: string list; pkgs: (string, string) Hashtbl.t} - -(** Source directories are pre-expanded by the build system and supplied via - [-bs-gentype-source-dir] flags — we just filter to the ones that actually - exist on disk under the project root. *) -let read_dirs_from_config ~(config : Config.t) = - let ( +++ ) = Filename.concat in - let root = config.project_root in - config.sources - |> List.filter (fun dir -> - let abs_dir = - match dir = "" with - | true -> root - | false -> root +++ dir - in - Sys.file_exists abs_dir && Sys.is_directory abs_dir) - -let read_source_dirs ~(config : Config.t) = - let source_dirs = - ["lib"; "bs"; ".sourcedirs.json"] - |> List.fold_left ( +++ ) config.bsb_project_root - in - let dirs = ref [] in - let pkgs = Hashtbl.create 1 in - let read_dirs json = - match json with - | Ext_json_types.Obj {map} -> ( - match Map_string.find_opt map "dirs" with - | Some (Arr {content}) -> - content - |> Array.iter (fun x -> - match x with - | Ext_json_types.Str {str} -> dirs := str :: !dirs - | _ -> ()); - () - | _ -> ()) - | _ -> () - in - let read_pkgs json = - match json with - | Ext_json_types.Obj {map} -> ( - match Map_string.find_opt map "pkgs" with - | Some (Arr {content}) -> - content - |> Array.iter (fun x -> - match x with - | Ext_json_types.Arr - {content = [|Str {str = name}; Str {str = path}|]} -> - Hashtbl.add pkgs name path - | _ -> ()); - () - | _ -> ()) - | _ -> () - in - if source_dirs |> Sys.file_exists then - try - let json = source_dirs |> Ext_json_parse.parse_json_from_file in - if config.bsb_project_root <> config.project_root then - dirs := read_dirs_from_config ~config - else read_dirs json; - read_pkgs json - with _ -> () - else ( - Log_.item "Warning: can't find source dirs: %s\n" source_dirs; - Log_.item "Types for cross-references will not be found by genType.\n"; - dirs := read_dirs_from_config ~config); - {dirs = !dirs; pkgs} - -(** Read the project's .sourcedirs.json file if it exists - and build a map of the files with the given extension - back to the directory where they belong. *) -let sourcedirs_json_to_map ~config ~extensions ~exclude_file = +(** Build a map of source filenames (with the given extensions) back to the + directory where they belong. Source directories and dependency install + paths are provided by the build system through CLI flags. *) +let sourcedirs_to_map ~(config : Config.t) ~extensions ~exclude_file = let rec chop_extensions fname = match fname |> Filename.chop_extension with | fname_chopped -> fname_chopped |> chop_extensions @@ -112,15 +44,15 @@ let sourcedirs_json_to_map ~config ~extensions ~exclude_file = (fname |> chop_extensions |> ModuleName.from_string_unsafe) dir_emitted) in - let {dirs; pkgs} = read_source_dirs ~config in - dirs + config.sources |> List.iter (fun dir -> - add_dir ~dir_emitted:dir - ~dir_on_disk:(config.project_root +++ dir) - ~filter:filter_given_extension ~map:file_map); + let dir_on_disk = config.project_root +++ dir in + if Sys.file_exists dir_on_disk && Sys.is_directory dir_on_disk then + add_dir ~dir_emitted:dir ~dir_on_disk ~filter:filter_given_extension + ~map:file_map); config.bs_dependencies |> List.iter (fun package_name -> - match Hashtbl.find pkgs package_name with + match Hashtbl.find config.dep_paths package_name with | path -> let root = ["lib"; "bs"] |> List.fold_left ( +++ ) path in let filter file_name = @@ -149,7 +81,7 @@ let create_lazy_resolver ~config ~extensions ~exclude_file = lazy_find = lazy (let module_name_map, bs_dependencies_file_map = - sourcedirs_json_to_map ~config ~extensions ~exclude_file + sourcedirs_to_map ~config ~extensions ~exclude_file in let find ~bs_dependencies ~map module_name = match map |> ModuleNameMap.find module_name with diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index 8244adb6c43..2d9089ecef5 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -605,7 +605,20 @@ pub fn compiler_args( let jsx_mode_args = root_config.get_jsx_mode_args(); let jsx_preserve_args = root_config.get_jsx_preserve_args(); let bsb_project_root = project_context.get_root_path(); - let gentype_arg = config.get_gentype_args(current_package_dirs, Some(bsb_project_root)); + let dep_paths: Vec<(String, PathBuf)> = if config.gentype_config.is_some() { + let resolved = packages.as_ref().map(|pkgs| { + config + .dependencies + .iter() + .flatten() + .filter_map(|name| pkgs.get(name).map(|pkg| (name.clone(), pkg.path.clone()))) + .collect::>() + }); + resolved.unwrap_or_default() + } else { + Vec::new() + }; + let gentype_arg = config.get_gentype_args(current_package_dirs, Some(bsb_project_root), &dep_paths); let experimental_args = root_config.get_experimental_features_args(); let warning_args = config.get_warning_args(is_local_dep, warn_error_override); diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 5d1edcd51e9..94d79cbe886 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -715,7 +715,12 @@ impl Config { /// Build the full set of `-bs-gentype-*` CLI flags for a bsc invocation. /// `source_dirs` are pre-expanded directories relative to the package root. - pub fn get_gentype_args(&self, source_dirs: &[PathBuf], bsb_project_root: Option<&Path>) -> Vec { + pub fn get_gentype_args( + &self, + source_dirs: &[PathBuf], + bsb_project_root: Option<&Path>, + dep_paths: &[(String, PathBuf)], + ) -> Vec { let Some(gt) = &self.gentype_config else { return vec![]; }; @@ -766,6 +771,12 @@ impl Config { args.push("-bs-gentype-source-dir".to_string()); args.push(dir.to_string_lossy().to_string()); } + let mut dep_paths_sorted: Vec<&(String, PathBuf)> = dep_paths.iter().collect(); + dep_paths_sorted.sort_by(|a, b| a.0.cmp(&b.0)); + for (name, path) in dep_paths_sorted { + args.push("-bs-gentype-dep-path".to_string()); + args.push(format!("{}={}", name, path.to_string_lossy())); + } if let Some(root) = bsb_project_root { args.push("-bs-gentype-bsb-project-root".to_string()); args.push(root.to_string_lossy().to_string()); @@ -1205,7 +1216,7 @@ pub mod tests { assert_eq!(gt.module, Some(GenTypeModule::EsModule)); assert_eq!(gt.generated_file_extension.as_deref(), Some(".gen.tsx")); - let args = config.get_gentype_args(&[], None); + let args = config.get_gentype_args(&[], None, &[]); assert!(args.contains(&"-bs-gentype".to_string())); assert!(args.contains(&"-bs-gentype-module".to_string())); assert!(args.contains(&"esmodule".to_string())); @@ -1236,7 +1247,7 @@ pub mod tests { } "#; let config = serde_json::from_str::(json).unwrap(); - assert!(config.get_gentype_args(&[], None).is_empty()); + assert!(config.get_gentype_args(&[], None, &[]).is_empty()); } #[test] diff --git a/tests/ounit_tests/ounit_ext_json_tests.ml b/tests/ounit_tests/ounit_ext_json_tests.ml deleted file mode 100644 index 00ceefd492a..00000000000 --- a/tests/ounit_tests/ounit_ext_json_tests.ml +++ /dev/null @@ -1,153 +0,0 @@ -let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) -type t = Ext_json_noloc.t -let rec equal (x : t) (y : t) = - match x with - | Null -> ( - (* [%p? Null _ ] *) - match y with - | Null -> true - | _ -> false) - | Str str -> ( - match y with - | Str str2 -> str = str2 - | _ -> false) - | Flo flo -> ( - match y with - | Flo flo2 -> flo = flo2 - | _ -> false) - | True -> ( - match y with - | True -> true - | _ -> false) - | False -> ( - match y with - | False -> true - | _ -> false) - | Arr content -> ( - match y with - | Arr content2 -> Ext_array.for_all2_no_exn content content2 equal - | _ -> false) - | Obj map -> ( - match y with - | Obj map2 -> - let xs = - Map_string.bindings map |> List.sort (fun (a, _) (b, _) -> compare a b) - in - let ys = - Map_string.bindings map2 |> List.sort (fun (a, _) (b, _) -> compare a b) - in - Ext_list.for_all2_no_exn xs ys (fun (k0, v0) (k1, v1) -> - k0 = k1 && equal v0 v1) - | _ -> false) - -open Ext_json_parse -let ( |? ) m (key, cb) = m |> Ext_json.test key cb - -let rec strip (x : Ext_json_types.t) : Ext_json_noloc.t = - let open Ext_json_noloc in - match x with - | True _ -> true_ - | False _ -> false_ - | Null _ -> null - | Flo {flo = s} -> flo s - | Str {str = s} -> str s - | Arr {content} -> arr (Array.map strip content) - | Obj {map} -> obj (Map_string.map map strip) - -let id_parsing_serializing x = - let normal_s = - Ext_json_noloc.to_string @@ strip @@ Ext_json_parse.parse_json_from_string x - in - let normal_ss = - Ext_json_noloc.to_string @@ strip - @@ Ext_json_parse.parse_json_from_string normal_s - in - if normal_s <> normal_ss then ( - prerr_endline "ERROR"; - prerr_endline normal_s; - prerr_endline normal_ss); - OUnit.assert_equal ~cmp:(fun (x : string) y -> x = y) normal_s normal_ss - -let id_parsing_x2 x = - let stru = Ext_json_parse.parse_json_from_string x |> strip in - let normal_s = Ext_json_noloc.to_string stru in - let normal_ss = strip (Ext_json_parse.parse_json_from_string normal_s) in - if equal stru normal_ss then true - else ( - prerr_endline "ERROR"; - prerr_endline normal_s; - Format.fprintf Format.err_formatter "%a@.%a@." Ext_obj.pp_any stru - Ext_obj.pp_any normal_ss; - - prerr_endline (Ext_json_noloc.to_string normal_ss); - false) - -let test_data = - [ - {| - {} - |}; - {| [] |}; - {| [1,2,3]|}; - {| ["x", "y", 1,2,3 ]|}; - {| { "x" : 3, "y" : "x", "z" : [1,2,3, "x"] }|}; - {| {"x " : true , "y" : false , "z\"" : 1} |}; - ] -exception Parse_error -let suites = - __FILE__ - >::: [ - (__LOC__ >:: fun _ -> List.iter id_parsing_serializing test_data); - ( __LOC__ >:: fun _ -> - List.iteri - (fun i x -> - OUnit.assert_bool (__LOC__ ^ string_of_int i) (id_parsing_x2 x)) - test_data ); - ( "empty_json" >:: fun _ -> - let v = parse_json_from_string "{}" in - match v with - | Obj {map = v} -> OUnit.assert_equal (Map_string.is_empty v) true - | _ -> OUnit.assert_failure "should be empty" ); - ( "empty_arr" >:: fun _ -> - let v = parse_json_from_string "[]" in - match v with - | Arr {content = [||]} -> () - | _ -> OUnit.assert_failure "should be empty" ); - ( "empty trails" >:: fun _ -> - ( OUnit.assert_raises Parse_error @@ fun _ -> - try parse_json_from_string {| [,]|} with _ -> raise Parse_error ); - OUnit.assert_raises Parse_error @@ fun _ -> - try parse_json_from_string {| {,}|} with _ -> raise Parse_error ); - ( "two trails" >:: fun _ -> - ( OUnit.assert_raises Parse_error @@ fun _ -> - try parse_json_from_string {| [1,2,,]|} - with _ -> raise Parse_error ); - OUnit.assert_raises Parse_error @@ fun _ -> - try parse_json_from_string {| { "x": 3, ,}|} - with _ -> raise Parse_error ); - ( "two trails fail" >:: fun _ -> - OUnit.assert_raises Parse_error @@ fun _ -> - try parse_json_from_string {| { "x": 3, 2 ,}|} - with _ -> raise Parse_error ); - ( "trail comma obj" >:: fun _ -> - let v = parse_json_from_string {| { "x" : 3 , }|} in - let v1 = parse_json_from_string {| { "x" : 3 , }|} in - let test (v : Ext_json_types.t) = - match v with - | Obj {map = v} -> - v |? ("x", `Flo (fun x -> OUnit.assert_equal x "3")) |> ignore - | _ -> OUnit.assert_failure "trail comma" - in - test v; - test v1 ); - ( "trail comma arr" >:: fun _ -> - let v = parse_json_from_string {| [ 1, 3, ]|} in - let v1 = parse_json_from_string {| [ 1, 3 ]|} in - let test (v : Ext_json_types.t) = - match v with - | Arr {content = [|Flo {flo = "1"}; Flo {flo = "3"}|]} -> () - | _ -> OUnit.assert_failure "trailing comma array" - in - test v; - test v1 ); - ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index b463e105027..835dec66b97 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -3,7 +3,6 @@ let suites = [ Ounit_vec_test.suites; Ounit_json_tests.suites; - Ounit_ext_json_tests.suites; Ounit_array_tests.suites; Ounit_scc_tests.suites; Ounit_list_test.suites; diff --git a/tests/ounit_tests/ounit_vec_test.ml b/tests/ounit_tests/ounit_vec_test.ml index b38d0e0a6c6..23f4ab41c21 100644 --- a/tests/ounit_tests/ounit_vec_test.ml +++ b/tests/ounit_tests/ounit_vec_test.ml @@ -1,7 +1,5 @@ let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) -(* open Ext_json *) - let v = Vec_int.init 10 (fun i -> i) let ( =~ ) x y = OUnit.assert_equal ~cmp:(Vec_int.equal (fun (x : int) y -> x = y)) x y From c26d036a83d4e7432d7292d506dcb2f9e740362b Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 11:35:18 +0200 Subject: [PATCH 05/13] Delete unused ext modules Three small modules in compiler/ext had no callers anywhere in the repo (neither in production code, nor in tests): - ext_color: unused color/ANSI helpers - ext_position: unused Lexing.position utilities - ext_string_array: unused string-array helpers Removed alongside the Ext_json cleanup. Build and tests unchanged. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/ext/ext_color.ml | 74 ------------------------- compiler/ext/ext_color.mli | 32 ----------- compiler/ext/ext_position.ml | 56 ------------------- compiler/ext/ext_position.mli | 43 --------------- compiler/ext/ext_string_array.ml | 91 ------------------------------- compiler/ext/ext_string_array.mli | 29 ---------- 6 files changed, 325 deletions(-) delete mode 100644 compiler/ext/ext_color.ml delete mode 100644 compiler/ext/ext_color.mli delete mode 100644 compiler/ext/ext_position.ml delete mode 100644 compiler/ext/ext_position.mli delete mode 100644 compiler/ext/ext_string_array.ml delete mode 100644 compiler/ext/ext_string_array.mli diff --git a/compiler/ext/ext_color.ml b/compiler/ext/ext_color.ml deleted file mode 100644 index db926ead039..00000000000 --- a/compiler/ext/ext_color.ml +++ /dev/null @@ -1,74 +0,0 @@ -(* 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 color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White - -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" - | Bold -> "1" - | Dim -> "2" - -(** TODO: add more styles later *) -let style_of_tag s = - match s with - | Format.String_tag "error" -> [Bold; FG Red] - | Format.String_tag "warning" -> [Bold; FG Magenta] - | Format.String_tag "info" -> [Bold; FG Yellow] - | Format.String_tag "dim" -> [Dim] - | Format.String_tag "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 reset_lit = "\x1b[0m" diff --git a/compiler/ext/ext_color.mli b/compiler/ext/ext_color.mli deleted file mode 100644 index d2aa148455d..00000000000 --- a/compiler/ext/ext_color.mli +++ /dev/null @@ -1,32 +0,0 @@ -(* 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 color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White - -type style = FG of color | BG of color | Bold | Dim - -val ansi_of_tag : Format.stag -> string -(** Input is the tag for example `@{@}` return escape code *) - -val reset_lit : string diff --git a/compiler/ext/ext_position.ml b/compiler/ext/ext_position.ml deleted file mode 100644 index a15409429d0..00000000000 --- a/compiler/ext/ext_position.ml +++ /dev/null @@ -1,56 +0,0 @@ -(* 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 = Lexing.position = { - pos_fname: string; - pos_lnum: int; - pos_bol: int; - pos_cnum: int; -} - -let offset (x : t) (y : t) = - { - x with - pos_lnum = x.pos_lnum + y.pos_lnum - 1; - pos_cnum = x.pos_cnum + y.pos_cnum; - pos_bol = (if y.pos_lnum = 1 then x.pos_bol else x.pos_cnum + y.pos_bol); - } - -let print fmt (pos : t) = - Format.fprintf fmt "(line %d, column %d)" pos.pos_lnum - (pos.pos_cnum - pos.pos_bol) - -let lexbuf_from_channel_with_fname ic fname = - let x = Lexing.from_function (fun buf n -> input ic buf 0 n) in - let pos : t = - { - pos_fname = fname; - pos_lnum = 1; - pos_bol = 0; - pos_cnum = 0 (* copied from zero_pos*); - } - in - x.lex_start_p <- pos; - x.lex_curr_p <- pos; - x diff --git a/compiler/ext/ext_position.mli b/compiler/ext/ext_position.mli deleted file mode 100644 index 7d0a0563ca2..00000000000 --- a/compiler/ext/ext_position.mli +++ /dev/null @@ -1,43 +0,0 @@ -(* 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 = Lexing.position = { - pos_fname: string; - pos_lnum: int; - pos_bol: int; - pos_cnum: int; -} - -val offset : t -> t -> t -(** [offset pos newpos] - return a new position - here [newpos] is zero based, the use case is that - at position [pos], we get a string and Lexing from that string, - therefore, we get a [newpos] and we need rebase it on top of - [pos] -*) - -val lexbuf_from_channel_with_fname : in_channel -> string -> Lexing.lexbuf - -val print : Format.formatter -> t -> unit diff --git a/compiler/ext/ext_string_array.ml b/compiler/ext/ext_string_array.ml deleted file mode 100644 index 0e3fb420506..00000000000 --- a/compiler/ext/ext_string_array.ml +++ /dev/null @@ -1,91 +0,0 @@ -(* Copyright (C) 2020 - Present Hongbo Zhang, Authors of ReScript - * - * 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. *) - -(* Invariant: the same as encoding Map_string.compare_key *) -let cmp = Ext_string.compare - -let rec binary_search_aux (arr : string array) (lo : int) (hi : int) - (key : string) : _ option = - let mid = (lo + hi) / 2 in - let mid_val = Array.unsafe_get arr mid in - let c = cmp key mid_val in - if c = 0 then Some mid - else if c < 0 then - (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let lo_val = Array.unsafe_get arr lo in - if lo_val = key then Some lo else None - else binary_search_aux arr lo mid key - else if - (* a[lo] =< a[mid] < key <= a[hi] *) - lo = mid - then - let hi_val = Array.unsafe_get arr hi in - if hi_val = key then Some hi else None - else binary_search_aux arr mid hi key - -let find_sorted sorted key : int option = - let len = Array.length sorted in - if len = 0 then None - else - let lo = Array.unsafe_get sorted 0 in - let c = cmp key lo in - if c < 0 then None - else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = cmp key hi in - if c2 > 0 then None else binary_search_aux sorted 0 (len - 1) key - -let rec binary_search_assoc (arr : (string * _) array) (lo : int) (hi : int) - (key : string) : _ option = - let mid = (lo + hi) / 2 in - let mid_val = Array.unsafe_get arr mid in - let c = cmp key (fst mid_val) in - if c = 0 then Some (snd mid_val) - else if c < 0 then - (* a[lo] =< key < a[mid] <= a[hi] *) - if hi = mid then - let lo_val = Array.unsafe_get arr lo in - if fst lo_val = key then Some (snd lo_val) else None - else binary_search_assoc arr lo mid key - else if - (* a[lo] =< a[mid] < key <= a[hi] *) - lo = mid - then - let hi_val = Array.unsafe_get arr hi in - if fst hi_val = key then Some (snd hi_val) else None - else binary_search_assoc arr mid hi key - -let find_sorted_assoc (type a) (sorted : (string * a) array) (key : string) : - a option = - let len = Array.length sorted in - if len = 0 then None - else - let lo = Array.unsafe_get sorted 0 in - let c = cmp key (fst lo) in - if c < 0 then None - else - let hi = Array.unsafe_get sorted (len - 1) in - let c2 = cmp key (fst hi) in - if c2 > 0 then None else binary_search_assoc sorted 0 (len - 1) key diff --git a/compiler/ext/ext_string_array.mli b/compiler/ext/ext_string_array.mli deleted file mode 100644 index 09c196e313d..00000000000 --- a/compiler/ext/ext_string_array.mli +++ /dev/null @@ -1,29 +0,0 @@ -(* Copyright (C) 2020 - Present Authors of ReScript - * - * 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 cmp : string -> string -> int - -val find_sorted : string array -> string -> int option - -val find_sorted_assoc : (string * 'a) array -> string -> 'a option From d423388997a858524d23892defb749ba123ded7b Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 11:42:09 +0200 Subject: [PATCH 06/13] Preserve package-specs.module fallback for gentype MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When gentypeconfig.module is omitted, the old JSON-reading path fell back to package-specs.module (object form) before defaulting to ESModule. My flag-based rewrite dropped that fallback, so a project with "package-specs": { "module": "commonjs" } but no explicit gentypeconfig.module would suddenly emit ESModule-style imports — breaking downstream TypeScript consumption. Replay the old precedence in rewatch when assembling -bs-gentype-module: 1. gentypeconfig.module if set 2. else package-specs.module when package-specs is a single object 3. else leave the flag off (bsc applies its ESModule default, same as before) Array-form package-specs still doesn't feed the fallback — that matches the old code's Obj-only pattern exactly. Added two tests covering both paths. Co-Authored-By: Claude Opus 4.7 (1M context) --- rewatch/src/config.rs | 55 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 53 insertions(+), 2 deletions(-) diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 94d79cbe886..6731ec2028e 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -726,9 +726,20 @@ impl Config { }; let mut args = vec!["-bs-gentype".to_string()]; - if let Some(module) = >.module { + // Match the pre-refactor precedence: gentypeconfig.module wins, then + // object-form package-specs.module is used as a fallback, otherwise + // leave bsc to apply its own default (ESModule). + let module_override = + gt.module + .as_ref() + .map(|m| m.as_str().to_string()) + .or_else(|| match &self.package_specs { + Some(OneOrMore::Single(spec)) => Some(spec.module.as_str().to_string()), + _ => None, + }); + if let Some(module) = module_override { args.push("-bs-gentype-module".to_string()); - args.push(module.as_str().to_string()); + args.push(module); } if let Some(resolution) = >.module_resolution { args.push("-bs-gentype-module-resolution".to_string()); @@ -1238,6 +1249,46 @@ pub mod tests { assert_eq!(array_form.0.get("A"), Some(&"B".to_string())); } + #[test] + fn test_gentype_module_falls_back_to_package_specs_module() { + // If gentypeconfig.module is omitted but package-specs is a single + // object with "module": "commonjs", the old JSON-reading code used + // that as the fallback. Preserve that behavior via the CLI flags. + let json = r#" + { + "name": "pkg", + "sources": [ { "dir": "src", "subdirs": true } ], + "package-specs": { "module": "commonjs", "in-source": true }, + "suffix": ".bs.js", + "gentypeconfig": { + "generatedFileExtension": ".gen.tsx" + } + } + "#; + let config = serde_json::from_str::(json).unwrap(); + let args = config.get_gentype_args(&[], None, &[]); + let module_idx = args.iter().position(|s| s == "-bs-gentype-module").unwrap(); + assert_eq!(args[module_idx + 1], "commonjs"); + } + + #[test] + fn test_gentype_module_explicit_wins_over_package_specs() { + let json = r#" + { + "name": "pkg", + "sources": [ { "dir": "src", "subdirs": true } ], + "package-specs": { "module": "commonjs", "in-source": true }, + "gentypeconfig": { + "module": "esmodule" + } + } + "#; + let config = serde_json::from_str::(json).unwrap(); + let args = config.get_gentype_args(&[], None, &[]); + let module_idx = args.iter().position(|s| s == "-bs-gentype-module").unwrap(); + assert_eq!(args[module_idx + 1], "esmodule"); + } + #[test] fn test_gentype_args_without_gentype_config() { let json = r#" From 8e2c85e971319974defee8759d017c3799f4c80e Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 11:59:25 +0200 Subject: [PATCH 07/13] Preserve list-order and dep-path-order semantics from the old code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two small alignments found during a detailed behavioral review. Each only matters in a pathological collision case (two dirs / deps with the same module name), but worth getting right since this PR promises byte-identical behavior. 1. bs_dependencies / sources: old code accumulated these with a prepend into a ref and returned the ref unreversed, so iteration proceeded in reverse-input order. My new code did List.rev and flipped the order, which would swap the last-write-wins winner in ModuleResolver's file_map on collision. Drop the List.rev. 2. dep_paths: I was sorting alphabetically in rewatch. The old code iterated the .sourcedirs.json "pkgs" array in order. Remove the sort and pass the caller's order through unchanged. Not preserved (agreed with reviewer that this was a bug): the old code's namespace field was populated from the cmt filename only when rescript.json had {"namespace": true} literally. For string-valued namespaces like {"namespace": "Custom"}, the old pattern match fell through and returned None — gentype then emitted imports like ./Module pointing at files actually named Module-Custom.bs.js. The new code (always use the cmt-derived namespace) is correct. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/gentype/GenTypeConfig.ml | 8 ++++++-- rewatch/src/config.rs | 6 +++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/compiler/gentype/GenTypeConfig.ml b/compiler/gentype/GenTypeConfig.ml index deee28da3a9..926922c1b2b 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -156,9 +156,13 @@ let build_config ~namespace = List.iter (fun (name, path) -> Hashtbl.add tbl name path) !dep_paths_flag; tbl in + (* Old code accumulated these lists via prepend and returned them + unreversed, so iteration proceeded in reverse input order. Keep that + behavior so that last-write-wins in ModuleNameMap produces the same + winner when two dirs / deps contribute the same module name. *) { bsb_project_root; - bs_dependencies = List.rev !bs_dependencies_flag; + bs_dependencies = !bs_dependencies_flag; dep_paths; emit_import_curry = false; emit_import_react = false; @@ -172,6 +176,6 @@ let build_config ~namespace = platform_lib = "rescript"; project_root; shims_map; - sources = List.rev !source_dirs_flag; + sources = !source_dirs_flag; suffix; } diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 6731ec2028e..35eacb884e1 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -782,9 +782,9 @@ impl Config { args.push("-bs-gentype-source-dir".to_string()); args.push(dir.to_string_lossy().to_string()); } - let mut dep_paths_sorted: Vec<&(String, PathBuf)> = dep_paths.iter().collect(); - dep_paths_sorted.sort_by(|a, b| a.0.cmp(&b.0)); - for (name, path) in dep_paths_sorted { + // Preserve caller's order so the resulting Hashtbl has last-added + // semantics equivalent to the old pkgs-array iteration. + for (name, path) in dep_paths { args.push("-bs-gentype-dep-path".to_string()); args.push(format!("{}={}", name, path.to_string_lossy())); } From d622fdab14c8af90a950cd9166c606e3f5ce347c Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 12:09:20 +0200 Subject: [PATCH 08/13] Cache gentype source-dir walk on Package MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit collect_gentype_source_dirs was being called from compiler_args — i.e. once per source file per build. The result is per-package and doesn't change during a build, so the redundant walks were pure waste on gentype-enabled projects with many files. Move the walk into package discovery (packages::make), cache it on a new Package.gentype_dirs field, and only compute it for packages that have a gentype_config. compiler_args now just borrows the cached slice. Co-Authored-By: Claude Opus 4.7 (1M context) --- rewatch/src/build/compile.rs | 63 +++-------------------------------- rewatch/src/build/packages.rs | 59 ++++++++++++++++++++++++++++++++ rewatch/src/watcher.rs | 1 + 3 files changed, 64 insertions(+), 59 deletions(-) diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index 2d9089ecef5..c646309ef7b 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -472,56 +472,6 @@ pub fn compile( Ok((compile_errors, compile_warnings, num_compiled_modules)) } -/// Walks a package's declared source folders and returns every directory -/// reachable under them (honoring `subdirs: true`), relative to the package -/// root. Mirrors the filesystem walk gentype used to perform from -/// `rescript.json` when resolving cross-file imports. -fn collect_gentype_source_dirs(package: &packages::Package) -> Vec { - let mut out: Vec = Vec::new(); - let root = &package.path; - - fn walk_recursive(root: &Path, rel: &Path, out: &mut Vec) { - let abs = if rel.as_os_str().is_empty() { - root.to_path_buf() - } else { - root.join(rel) - }; - let Ok(meta) = std::fs::metadata(&abs) else { - return; - }; - if !meta.is_dir() { - return; - } - out.push(rel.to_path_buf()); - let Ok(entries) = std::fs::read_dir(&abs) else { - return; - }; - for entry in entries.flatten() { - let Ok(child_meta) = entry.metadata() else { - continue; - }; - if child_meta.is_dir() { - let name = entry.file_name(); - walk_recursive(root, &rel.join(name), out); - } - } - } - - for source in &package.source_folders { - let rel = PathBuf::from(&source.dir); - match &source.subdirs { - Some(config::Subdirs::Recurse(true)) => walk_recursive(root, &rel, &mut out), - _ => { - let abs = root.join(&rel); - if abs.is_dir() { - out.push(rel); - } - } - } - } - out -} - static RUNTIME_PATH_MEMO: OnceLock = OnceLock::new(); pub fn get_runtime_path(package_config: &Config, project_context: &ProjectContext) -> Result { @@ -822,14 +772,9 @@ fn compile_file( helpers::file_path_to_compiler_asset_basename(implementation_file_path, &package.namespace); let has_interface = module.get_interface().is_some(); let is_type_dev = module.is_type_dev; - // Gentype resolves cross-file imports by walking every directory reachable - // from the sources tree (including dirs that hold only `.ts` shims), - // so we can't rely on `package.dirs` which only tracks `.res` dirs. - let current_package_dirs: Vec = if package.config.gentype_config.is_some() { - collect_gentype_source_dirs(package) - } else { - Vec::new() - }; + // `gentype_dirs` is populated once during package discovery, so we just + // borrow the cached slice here (empty when gentype is off). + let current_package_dirs: &[PathBuf] = package.gentype_dirs.as_deref().unwrap_or(&[]); let to_mjs_args = compiler_args( &package.config, ast_path, @@ -841,7 +786,7 @@ fn compile_file( is_type_dev, package.is_local_dep, warn_error_override, - ¤t_package_dirs, + current_package_dirs, )?; let to_mjs = Command::new(&compiler_info.bsc_path) diff --git a/rewatch/src/build/packages.rs b/rewatch/src/build/packages.rs index c1f22d8ed3a..e295d378430 100644 --- a/rewatch/src/build/packages.rs +++ b/rewatch/src/build/packages.rs @@ -63,6 +63,11 @@ pub struct Package { // canonicalized dir of the package pub path: PathBuf, pub dirs: Option>, + /// Every directory reachable from `source_folders` (honoring + /// `subdirs: true`), relative to the package root — including ones that + /// hold only `.ts` shim files and therefore are absent from `dirs`. + /// Populated during package discovery only when gentype is enabled. + pub gentype_dirs: Option>, pub is_local_dep: bool, pub is_root: bool, } @@ -504,6 +509,7 @@ This inconsistency will cause issues with package resolution.\n", .map(StrippedVerbatimPath::to_stripped_verbatim_path) .expect("Could not canonicalize"), dirs: None, + gentype_dirs: None, is_local_dep, is_root, }) @@ -633,11 +639,63 @@ fn extend_with_children( dirs.insert(dir.to_owned()); }); package.dirs = Some(dirs); + if package.config.gentype_config.is_some() { + package.gentype_dirs = Some(collect_gentype_source_dirs(package)); + } package.source_files = Some(map); } build } +/// Walks a package's declared source folders and returns every directory +/// reachable under them (honoring `subdirs: true`), relative to the package +/// root. Gentype needs every such directory — including ones containing only +/// `.ts` shims — to resolve cross-file imports, so `package.dirs` (which +/// tracks only dirs with `.res` source files) isn't enough. +fn collect_gentype_source_dirs(package: &Package) -> Vec { + let mut out: Vec = Vec::new(); + let root = &package.path; + + fn walk_recursive(root: &Path, rel: &Path, out: &mut Vec) { + let abs = if rel.as_os_str().is_empty() { + root.to_path_buf() + } else { + root.join(rel) + }; + let Ok(meta) = std::fs::metadata(&abs) else { + return; + }; + if !meta.is_dir() { + return; + } + out.push(rel.to_path_buf()); + let Ok(entries) = std::fs::read_dir(&abs) else { + return; + }; + for entry in entries.flatten() { + let Ok(child_meta) = entry.metadata() else { + continue; + }; + if child_meta.is_dir() { + walk_recursive(root, &rel.join(entry.file_name()), out); + } + } + } + + for source in &package.source_folders { + let rel = PathBuf::from(&source.dir); + match &source.subdirs { + Some(config::Subdirs::Recurse(true)) => walk_recursive(root, &rel, &mut out), + _ => { + if root.join(&rel).is_dir() { + out.push(rel); + } + } + } + } + out +} + /// Make turns a folder, that should contain a config, into a tree of Packages. /// It does so in two steps: /// 1. Get all the packages parsed, and take all the source folders from the config @@ -1059,6 +1117,7 @@ mod test { modules: None, path: PathBuf::from("./something"), dirs: None, + gentype_dirs: None, is_root: false, is_local_dep: false, } diff --git a/rewatch/src/watcher.rs b/rewatch/src/watcher.rs index 3eba1f1d0b0..588ad0479e4 100644 --- a/rewatch/src/watcher.rs +++ b/rewatch/src/watcher.rs @@ -569,6 +569,7 @@ mod tests { modules: None, path: package_path, dirs: None, + gentype_dirs: None, is_local_dep: true, is_root: true, } From 971e8685285f44bf12e25f5ca83cbfbd0ddb448e Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 12:12:26 +0200 Subject: [PATCH 09/13] Derive Deserialize for GenTypeModule* enums MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The manual Deserialize impls were reinventing what serde can do with #[serde(rename = "...")] on each variant — the same pattern already in use for PackageModule in this file. Drop the hand-written impls in favor of derive; serde's default error message for unknown variants ("unknown variant `foo`, expected one of ...") is good enough. Co-Authored-By: Claude Opus 4.7 (1M context) --- rewatch/src/config.rs | 42 +++++++----------------------------------- 1 file changed, 7 insertions(+), 35 deletions(-) diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 35eacb884e1..977606fabb5 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -233,9 +233,11 @@ pub struct JsxSpecs { pub preserve: Option, } -#[derive(Debug, Clone, PartialEq, Eq)] +#[derive(Deserialize, Debug, Clone, PartialEq, Eq)] pub enum GenTypeModule { + #[serde(rename = "commonjs")] CommonJs, + #[serde(rename = "esmodule")] EsModule, } @@ -248,26 +250,13 @@ impl GenTypeModule { } } -impl<'de> Deserialize<'de> for GenTypeModule { - fn deserialize(deserializer: D) -> Result - where - D: Deserializer<'de>, - { - let raw = String::deserialize(deserializer)?; - match raw.as_str() { - "commonjs" => Ok(GenTypeModule::CommonJs), - "esmodule" => Ok(GenTypeModule::EsModule), - other => Err(DeError::custom(format!( - "Unknown gentypeconfig.module value '{other}'. Expected: commonjs | esmodule", - ))), - } - } -} - -#[derive(Debug, Clone, PartialEq, Eq)] +#[derive(Deserialize, Debug, Clone, PartialEq, Eq)] pub enum GenTypeModuleResolution { + #[serde(rename = "node")] Node, + #[serde(rename = "node16")] Node16, + #[serde(rename = "bundler")] Bundler, } @@ -281,23 +270,6 @@ impl GenTypeModuleResolution { } } -impl<'de> Deserialize<'de> for GenTypeModuleResolution { - fn deserialize(deserializer: D) -> Result - where - D: Deserializer<'de>, - { - let raw = String::deserialize(deserializer)?; - match raw.as_str() { - "node" => Ok(GenTypeModuleResolution::Node), - "node16" => Ok(GenTypeModuleResolution::Node16), - "bundler" => Ok(GenTypeModuleResolution::Bundler), - other => Err(DeError::custom(format!( - "Unknown gentypeconfig.moduleResolution value '{other}'. Expected: node | node16 | bundler", - ))), - } - } -} - /// Accepts either an object `{ "From": "To", ... }` or (deprecated) an array of /// `"From=To"` strings. #[derive(Debug, Clone, PartialEq, Eq, Default)] From 367d50e196247aec3f457ea27dc42497e896cbb6 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 13:55:17 +0200 Subject: [PATCH 10/13] Rename Ext_path.custom_package_dir to project_root MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit \"Custom\" was a holdover from when there were two sources for the package dir (CLI flag vs filesystem walk fallback) — \"custom\" meant \"CLI-set\" in contrast to the walked-up default. Now that the walk is gone, there's only one source and \"custom\" adds no information. Rename the ref to [project_root] so it matches the CLI flag name [-bs-project-root] directly. The getter stays [package_dir ()] since that's the established term used by [lam_compile_main] and [js_packages_info]. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/bsc/rescript_compiler_main.ml | 5 ++--- compiler/ext/ext_path.ml | 10 +++++----- compiler/ext/ext_path.mli | 9 ++++----- 3 files changed, 11 insertions(+), 13 deletions(-) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index 581f6d41860..67fbc0043de 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -265,10 +265,9 @@ let command_line_flags : (string * Bsc_args.spec * string) array = 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' " ); ( "-bs-project-root", string_call (fun s -> - Ext_path.custom_package_dir := Some s; + Ext_path.project_root := Some s; GenTypeConfig.project_root := s), - "*internal* Set the project root directory, avoiding a filesystem walk \ - for rescript.json" ); + "*internal* Set the project root directory" ); ( "-bs-ast", unit_call (fun _ -> Js_config.binary_ast := true; diff --git a/compiler/ext/ext_path.ml b/compiler/ext/ext_path.ml index 629e11aeb0f..cfe8b5cb7a9 100644 --- a/compiler/ext/ext_path.ml +++ b/compiler/ext/ext_path.ml @@ -110,13 +110,13 @@ let absolute_cwd_path s = absolute_path cwd s | File x -> File (absolute_path cwd x ) | Dir x -> Dir (absolute_path cwd x) *) -(** Set by [-bs-project-root] to tell the compiler where the package root is. - The build system (rewatch) or [cli/bsc.js] is responsible for supplying it; - the compiler no longer reads [rescript.json] itself. *) -let custom_package_dir : string option ref = ref None +(** Populated by [-bs-project-root]. The build system (rewatch) or + [cli/bsc.js] is responsible for supplying it; the compiler no longer + reads [rescript.json] itself. *) +let project_root : string option ref = ref None let package_dir () = - match !custom_package_dir with + match !project_root with | Some dir -> dir | None -> Ext_fmt.failwithf ~loc:__LOC__ diff --git a/compiler/ext/ext_path.mli b/compiler/ext/ext_path.mli index 579e0448625..aa8b261c67d 100644 --- a/compiler/ext/ext_path.mli +++ b/compiler/ext/ext_path.mli @@ -29,10 +29,9 @@ val node_rebase_file : from:string -> to_:string -> string -> string val absolute_cwd_path : string -> string -val custom_package_dir : string option ref -(** Set by [-bs-project-root]. Must be populated before [package_dir ()] is - called; the compiler does not locate [rescript.json] on its own. *) +val project_root : string option ref +(** Populated by [-bs-project-root]. Must be set before [package_dir ()] + is called; the compiler does not locate [rescript.json] on its own. *) val package_dir : unit -> string -(** Returns the package root directory. Fails if [custom_package_dir] is - unset. *) +(** Returns the package root directory. Fails if [project_root] is unset. *) From e4f4c4c63bf4c90dd864fc9bc6cf0b039d048986 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 13:57:39 +0200 Subject: [PATCH 11/13] Drop misplaced comment in GenTypeConfig.build_config The comment was positioned above the record literal but only applied to two fields inside it, making it read as if it documented the whole construction. The invariant it described (kept via commit history) is better tracked in git blame than inlined at the call site. Co-Authored-By: Claude Opus 4.7 (1M context) --- compiler/gentype/GenTypeConfig.ml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/gentype/GenTypeConfig.ml b/compiler/gentype/GenTypeConfig.ml index 926922c1b2b..a4eafea44ea 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -156,10 +156,6 @@ let build_config ~namespace = List.iter (fun (name, path) -> Hashtbl.add tbl name path) !dep_paths_flag; tbl in - (* Old code accumulated these lists via prepend and returned them - unreversed, so iteration proceeded in reverse input order. Keep that - behavior so that last-write-wins in ModuleNameMap produces the same - winner when two dirs / deps contribute the same module name. *) { bsb_project_root; bs_dependencies = !bs_dependencies_flag; From e7d1174e4633a2d217e0c4b6bc3b158c4b4af58a Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 14:00:24 +0200 Subject: [PATCH 12/13] Add changelog entry for rescript.json read removal Co-Authored-By: Claude Opus 4.7 (1M context) --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 59b711b45e1..9cc4e436852 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,6 +36,8 @@ #### :house: Internal +- Move `rescript.json` reading out of the compiler (`bsc`) and into the build system. Rewatch now passes all gentype config and the package root as CLI flags; `bsc` no longer opens `rescript.json` or `.sourcedirs.json`. The custom OCaml JSON parser (`Ext_json*`) is removed. https://github.com/rescript-lang/rescript/pull/8365 + # 13.0.0-alpha.3 #### :boom: Breaking Change From d43bacdc9204df5c7c36c8b694a2929b295fb692 Mon Sep 17 00:00:00 2001 From: Jaap Frolich Date: Sun, 19 Apr 2026 14:01:00 +0200 Subject: [PATCH 13/13] Trim changelog entry Co-Authored-By: Claude Opus 4.7 (1M context) --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9cc4e436852..0c5f878be9d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,7 +36,7 @@ #### :house: Internal -- Move `rescript.json` reading out of the compiler (`bsc`) and into the build system. Rewatch now passes all gentype config and the package root as CLI flags; `bsc` no longer opens `rescript.json` or `.sourcedirs.json`. The custom OCaml JSON parser (`Ext_json*`) is removed. https://github.com/rescript-lang/rescript/pull/8365 +- Move `rescript.json` reading out of `bsc` into rewatch; remove the custom OCaml JSON parser. https://github.com/rescript-lang/rescript/pull/8365 # 13.0.0-alpha.3