diff --git a/CHANGELOG.md b/CHANGELOG.md index 59b711b45e1..0c5f878be9d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -36,6 +36,8 @@ #### :house: Internal +- 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 #### :boom: Breaking Change 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/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/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index c818eac295a..67fbc0043de 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -263,6 +263,11 @@ 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.project_root := Some s; + GenTypeConfig.project_root := s), + "*internal* Set the project root directory" ); ( "-bs-ast", unit_call (fun _ -> Js_config.binary_ast := true; @@ -293,6 +298,49 @@ 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-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 \ + .sourcedirs.json)" ); (******************************************************************************) ( "-unboxed-types", set Clflags.unboxed_types, 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/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_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_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/ext/ext_path.ml b/compiler/ext/ext_path.ml index ac36f0eca3f..cfe8b5cb7a9 100644 --- a/compiler/ext/ext_path.ml +++ b/compiler/ext/ext_path.ml @@ -110,21 +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] +(** 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 = lazy (find_config_dir (Lazy.force cwd)) +let package_dir () = + match !project_root with + | Some dir -> 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 1c0f15c1315..aa8b261c67d 100644 --- a/compiler/ext/ext_path.mli +++ b/compiler/ext/ext_path.mli @@ -29,5 +29,9 @@ 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 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 [project_root] is unset. *) 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 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" 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..a4eafea44ea 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -13,8 +13,11 @@ type module_resolution = type bs_version = int * int * int type t = { - mutable bsb_project_root: string; + 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; @@ -25,9 +28,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; } @@ -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; @@ -47,7 +51,7 @@ let default = platform_lib = ""; project_root = ""; shims_map = ModuleNameMap.empty; - sources = None; + sources = []; suffix = ".bs.js"; } @@ -59,187 +63,115 @@ 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 dep_paths_flag : (string * 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 + +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 = + 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 + match !bsb_project_root with + | "" -> project_root + | dir -> dir + in + let module_ = + match !module_flag with + | Some m -> m + | None -> default.module_ + in + let module_resolution = + match !module_resolution_flag with + | Some r -> r + | None -> default.module_resolution + in + let suffix = + match !suffix_flag with | Some s -> s + | None -> default.suffix 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; - } + 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)); + 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 - 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 + { + bsb_project_root; + bs_dependencies = !bs_dependencies_flag; + dep_paths; + 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 = !source_dirs_flag; + suffix; + } diff --git a/compiler/gentype/ModuleResolver.ml b/compiler/gentype/ModuleResolver.ml index 3adba146eea..c52efa3dd74 100644 --- a/compiler/gentype/ModuleResolver.ml +++ b/compiler/gentype/ModuleResolver.ml @@ -19,101 +19,10 @@ let read_bs_dependencies_dirs ~root = find_sub_dirs ""; !dirs -type pkgs = {dirs: string list; pkgs: (string, string) Hashtbl.t} - -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 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 @@ -135,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 = @@ -172,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/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 5247342a2a3..c646309ef7b 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -520,6 +520,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 +554,21 @@ 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 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); @@ -567,6 +584,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 +645,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(), @@ -753,6 +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_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, @@ -764,6 +786,7 @@ fn compile_file( is_type_dev, package.is_local_dep, warn_error_override, + 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/config.rs b/rewatch/src/config.rs index 1f0ea703489..977606fabb5 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -233,8 +233,95 @@ 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(Deserialize, Debug, Clone, PartialEq, Eq)] +pub enum GenTypeModule { + #[serde(rename = "commonjs")] + CommonJs, + #[serde(rename = "esmodule")] + EsModule, +} + +impl GenTypeModule { + pub fn as_str(&self) -> &'static str { + match self { + GenTypeModule::CommonJs => "commonjs", + GenTypeModule::EsModule => "esmodule", + } + } +} + +#[derive(Deserialize, Debug, Clone, PartialEq, Eq)] +pub enum GenTypeModuleResolution { + #[serde(rename = "node")] + Node, + #[serde(rename = "node16")] + Node16, + #[serde(rename = "bundler")] + Bundler, +} + +impl GenTypeModuleResolution { + pub fn as_str(&self) -> &'static str { + match self { + GenTypeModuleResolution::Node => "node", + GenTypeModuleResolution::Node16 => "node16", + GenTypeModuleResolution::Bundler => "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 +685,100 @@ 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>, + dep_paths: &[(String, PathBuf)], + ) -> Vec { + let Some(gt) = &self.gentype_config else { + return vec![]; + }; + let mut args = vec!["-bs-gentype".to_string()]; + + // 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); + } + 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()); + } + // 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())); + } + 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. + 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 { @@ -1019,8 +1195,82 @@ 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_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#" + { + "name": "pkg", + "sources": [ { "dir": "src/", "subdirs": true } ] + } + "#; + let config = serde_json::from_str::(json).unwrap(); + assert!(config.get_gentype_args(&[], None, &[]).is_empty()); } #[test] 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, } 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