fix(compiler): Report Win32 instead of Cygwin in JS compiler (#1251)

fix(compiler): Move Filename usage to Filepath.String & normalize separators

Author: phated

compiler/src/codegen/compcore.re

@@ -3806,7 +3806,7 @@ let compile_wasm_module = (~env=?, ~name=?, prog) => {
     ignore @@
     Module.add_debug_info_filename(
       wasm_mod,
-      Filename.basename(Option.get(name)),
+      Filepath.String.basename(Option.get(name)),
     );
   };
   let default_features = [

compiler/src/codegen/emitmod.re

@@ -22,7 +22,7 @@ let emit_module = ({asm, signature}, outfile) => {
   };
   let source_map_name =
     if (Config.source_map^) {
-      Some(Filename.basename(outfile) ++ ".map");
+      Some(Filepath.String.basename(outfile) ++ ".map");
     } else {
       None;
     };

compiler/src/compile.re

@@ -3,6 +3,7 @@ open Grain_typed;
 open Grain_middle_end;
 open Grain_codegen;
 open Grain_linking;
+open Grain_utils;
 open Optimize;
 
 type input_source =
@@ -39,21 +40,14 @@ type error =
 
 exception InlineFlagsError(Location.t, error);
 
-/** `remove_extension` new enough that we should just use this */
-
-let safe_remove_extension = name =>
-  try(Filename.chop_extension(name)) {
-  | Invalid_argument(_) => name
-  };
-
 let default_output_filename = name =>
-  safe_remove_extension(name) ++ ".gr.wasm";
+  Filepath.String.remove_extension(name) ++ ".gr.wasm";
 
 let default_assembly_filename = name =>
-  safe_remove_extension(name) ++ ".wast";
+  Filepath.String.remove_extension(name) ++ ".wast";
 
 let default_mashtree_filename = name =>
-  safe_remove_extension(name) ++ ".mashtree";
+  Filepath.String.remove_extension(name) ++ ".mashtree";
 
 let compile_prog = p =>
   Compcore.module_to_bytes @@ Compcore.compile_wasm_module(p);

compiler/src/linking/link.re

@@ -47,7 +47,7 @@ let is_grain_module = mod_name => {
 };
 
 let wasi_polyfill_module = () => {
-  Filename.remove_extension(Option.get(Config.wasi_polyfill_path()))
+  Filepath.String.remove_extension(Option.get(Config.wasi_polyfill_path()))
   ++ ".gr.wasm";
 };
 
@@ -59,7 +59,7 @@ let is_wasi_polyfill_module = mod_path => {
   mod_path == wasi_polyfill_module();
 };
 
-let new_base_dir = Filename.dirname;
+let new_base_dir = Filepath.String.dirname;
 
 let rec build_dependency_graph = (~base_dir, mod_path) => {
   let wasm_mod = Hashtbl.find(modules, mod_path);
@@ -591,7 +591,7 @@ let link_modules = ({asm: wasm_mod, signature}) => {
 
   G.add_vertex(dependency_graph, main_module);
   build_dependency_graph(
-    ~base_dir=Filename.dirname(main_module),
+    ~base_dir=Filepath.String.dirname(main_module),
     main_module,
   );
   let dependencies =

compiler/src/typed/env.re

@@ -749,7 +749,7 @@ let check_consistency = ps =>
         | Some(crc) =>
           let resolved_file_name =
             Module_resolution.resolve_unit(
-              ~base_dir=Filename.dirname(ps.ps_filename),
+              ~base_dir=Filepath.String.dirname(ps.ps_filename),
               name,
             );
           Consistbl.check(crc_units, resolved_file_name, crc, ps.ps_filename);

compiler/src/typed/module_resolution.re

@@ -50,15 +50,11 @@ let read_file_cmi = f => {
 };
 
 let get_output_name = name => {
-  let name =
-    try(Filename.chop_extension(name)) {
-    | Invalid_argument(_) => name
-    };
-  name ++ ".gr.wasm";
+  Filepath.String.remove_extension(name) ++ ".gr.wasm";
 };
 
 let find_ext_in_dir = (dir, name) => {
-  let fullname = Filename.concat(dir, name);
+  let fullname = Filepath.String.concat(dir, name);
   let rec process_ext =
     fun
     | [] => None
@@ -68,9 +64,6 @@ let find_ext_in_dir = (dir, name) => {
   process_ext;
 };
 
-let is_relpath = path =>
-  Filename.is_relative(path) && !Filename.is_implicit(path);
-
 let find_in_path_uncap = (~exts=[], base_dir, path, name) => {
   let rec try_dir =
     fun
@@ -81,14 +74,14 @@ let find_in_path_uncap = (~exts=[], base_dir, path, name) => {
         | None => try_dir(rem)
         };
       };
-  if (!Filename.is_relative(name) && Grain_utils.Fs_access.file_exists(name)) {
+  if (!Filepath.String.is_relative(name) && Fs_access.file_exists(name)) {
     (
       name,
-      Filename.dirname(name),
-      Filename.remove_extension(Filename.basename(name)),
-      Filename.extension(name),
+      Filepath.String.dirname(name),
+      Filepath.String.(remove_extension(basename(name))),
+      Filepath.String.extension(name),
     );
-  } else if (is_relpath(name)) {
+  } else if (Filepath.String.is_relpath(name)) {
     try_dir([base_dir]);
   } else {
     try(try_dir(path)) {
@@ -103,25 +96,18 @@ module PathTbl = {
 
   let add: (t('a), (string, string), 'a) => unit =
     (tbl, (dir, unit_name), v) => {
-      let dir = Grain_utils.Filepath.String.realpath_quick(dir);
-      Hashtbl.add(
-        tbl,
-        Grain_utils.Filepath.String.smart_cat(dir, unit_name),
-        v,
-      );
+      let dir = Filepath.String.realpath_quick(dir);
+      Hashtbl.add(tbl, Filepath.String.smart_cat(dir, unit_name), v);
     };
 
   let find_opt:
     (~disable_relpath: bool=?, t('a), string, list(string), string) =>
     option('a) =
     (~disable_relpath=false, tbl, base_path, path, unit_name) =>
-      if (!disable_relpath && is_relpath(unit_name)) {
+      if (!disable_relpath && Filepath.String.is_relpath(unit_name)) {
         Hashtbl.find_opt(
           tbl,
-          Grain_utils.Filepath.String.canonicalize_relpath(
-            base_path,
-            unit_name,
-          ),
+          Filepath.String.canonicalize_relpath(base_path, unit_name),
         );
       } else {
         List.fold_left(
@@ -131,9 +117,7 @@ module PathTbl = {
             | None =>
               Hashtbl.find_opt(
                 tbl,
-                Grain_utils.Filepath.String.(
-                  smart_cat(realpath_quick(elt), unit_name)
-                ),
+                Filepath.String.(smart_cat(realpath_quick(elt), unit_name)),
               )
             }
           },
@@ -169,8 +153,8 @@ let current_resolution_table = () => {
 
 let log_resolution = (unit_name, dir, basename) => {
   let resolution =
-    Grain_utils.Filepath.(
-      to_string @@ String.derelativize @@ Filename.concat(dir, basename)
+    Filepath.(
+      to_string @@ String.derelativize @@ String.concat(dir, basename)
     );
   PathTbl.add(current_resolution_table(), (dir, unit_name), resolution);
   resolution;
@@ -179,12 +163,12 @@ let log_resolution = (unit_name, dir, basename) => {
 let resolve_unit = (~search_path=?, ~cache=true, ~base_dir=?, unit_name) => {
   let base_dir =
     switch (base_dir) {
-    | None => Filename.dirname(current_filename^())
+    | None => Filepath.String.dirname(current_filename^())
     | Some(bd) => bd
     };
   let path =
     switch (search_path) {
-    | None => Grain_utils.Config.module_search_path()
+    | None => Config.module_search_path()
     | Some(p) => p
     };
   switch (
@@ -199,8 +183,8 @@ let resolve_unit = (~search_path=?, ~cache=true, ~base_dir=?, unit_name) => {
     if (cache) {
       log_resolution(unit_name, dir, basename);
     } else {
-      Grain_utils.Filepath.(
-        to_string @@ String.derelativize @@ Filename.concat(dir, basename)
+      Filepath.(
+        to_string @@ String.derelativize @@ String.concat(dir, basename)
       );
     };
   };
@@ -259,19 +243,19 @@ let located_to_out_file_name = (~base=?, located) => {
     | GrainModule(_, Some(outpath))
     | WasmModule(outpath) => outpath
     };
-  Grain_utils.Filepath.(to_string(String.derelativize(~base?, ret)));
+  Filepath.to_string(Filepath.String.derelativize(~base?, ret));
 };
 
 let locate_unit_object_file = (~path=?, ~base_dir=?, unit_name) => {
   let base_dir =
     switch (base_dir) {
-    | None => Filename.dirname(current_filename^())
+    | None => Filepath.String.dirname(current_filename^())
     | Some(bd) => bd
     };
   let path =
     switch (path) {
     | Some(p) => p
-    | None => Grain_utils.Config.module_search_path()
+    | None => Config.module_search_path()
     };
   located_to_out_file_name(locate_module(base_dir, path, unit_name));
 };
@@ -289,7 +273,7 @@ module Dependency_graph =
 
     let rec get_dependencies: (t, string => option(t)) => list(t) =
       (dn, lookup) => {
-        let base_dir = Filename.dirname(dn.dn_file_name);
+        let base_dir = Filepath.String.dirname(dn.dn_file_name);
         let active_search_path = Config.module_search_path();
         let located = dn.dn_latest_resolution^;
 
@@ -372,7 +356,7 @@ module Dependency_graph =
           // all dependencies have expected CRC, and the module was compiled with
           // the current compiler configuration. Otherwise, we need to recompile.
           let config_sum = Cmi_format.config_sum();
-          let base_dir = Filename.dirname(srcpath);
+          let base_dir = Filepath.String.dirname(srcpath);
           dn.dn_up_to_date :=
             (
               switch (read_file_cmi(objpath)) {
@@ -419,7 +403,7 @@ module Dependency_graph =
         | Some(WasmModule(_)) =>
           failwith("impossible: compile_module > WasmModule")
         | Some(GrainModule(srcpath, _)) =>
-          Grain_utils.Filepath.(to_string(String.derelativize(srcpath)))
+          Filepath.to_string(Filepath.String.derelativize(srcpath))
         };
       let outpath = get_output_name(srcpath);
       let loc = Option.value(loc, ~default=Grain_parsing.Location.dummy_loc);
@@ -429,8 +413,8 @@ module Dependency_graph =
         | Seq.Cons((parent, unit_name), _) => unit_name
         };
       with_preserve_unit^(~loc, chosen_unit_name, srcpath, () =>
-        Grain_utils.Warnings.with_preserve_warnings(() =>
-          Grain_utils.Config.preserve_config(() =>
+        Warnings.with_preserve_warnings(() =>
+          Config.preserve_config(() =>
             compile_module_dependency^(srcpath, outpath)
           )
         )
@@ -439,7 +423,7 @@ module Dependency_graph =
       dn.dn_up_to_date := true;
       PathTbl.add(
         current_located_module_cache(),
-        (Filename.dirname(outpath), chosen_unit_name),
+        (Filepath.String.dirname(outpath), chosen_unit_name),
         GrainModule(srcpath, Some(outpath)),
       );
     };
@@ -448,8 +432,8 @@ module Dependency_graph =
 let locate_module_file = (~loc, ~disable_relpath=false, unit_name) => {
   /* NOTE: We need to take care here to *not* wrap get_up_to_date with this try/with, since
      it will falsely raise No_module_file if a Not_found is raised during the compilation */
-  let base_dir = Filename.dirname(current_filename^());
-  let path = Grain_utils.Config.module_search_path();
+  let base_dir = Filepath.String.dirname(current_filename^());
+  let path = Config.module_search_path();
   let located =
     try(locate_module(~disable_relpath, base_dir, path, unit_name)) {
     | Not_found => error(No_module_file(unit_name, None))

compiler/src/typed/module_resolution.rei

@@ -28,5 +28,3 @@ let current_unit_name: ref(unit => string);
 let current_filename: ref(unit => string);
 
 let dump_dependency_graph: unit => unit;
-
-let is_relpath: string => bool;

compiler/src/utils/filepath.re

@@ -26,6 +26,8 @@ let derelativize = (~base=?, fname: Fp.firstClass) => {
   };
 };
 
+// All uses of `Filename` from OCaml should be constrained to this file because we need to do
+// normalization on the filepaths those functions produce.
 module String = {
   // This module is converting strings into Fp.t and then back into Strings
   // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
@@ -85,6 +87,44 @@ module String = {
     String.capitalize_ascii(name);
   };
 
+  let normalize_separators = path =>
+    if (Sys.unix) {
+      path;
+    } else {
+      // If we aren't on a Unix-style system, convert `\\` separators to `/`
+      // This is needed because using `Filename` from OCaml stdlib doesn't get along with Fp
+      let windows_sep = Str.regexp("\\");
+      let normal_sep = "/";
+      Str.global_replace(windows_sep, normal_sep, path);
+    };
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let concat = (p1, p2) => {
+    normalize_separators(Filename.concat(p1, p2));
+  };
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let dirname = path => {
+    normalize_separators(Filename.dirname(path));
+  };
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let basename = Filename.basename;
+
+  // TODO: This is poorly named
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let is_relpath = path =>
+    Filename.is_relative(path) && !Filename.is_implicit(path);
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let is_relative = Filename.is_relative;
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let check_suffix = Filename.check_suffix;
+
+  // TODO(#216): We should consider switching to type safe Fp.t where ever filepaths are used
+  let extension = Filename.extension;
+
   // TODO(#216): Turn this into a function that only operates on Fp
   let realpath = path => {
     switch (Fp.testForPath(path)) {
@@ -108,11 +148,12 @@ module String = {
   // TODO(#216): Turn this into a function that only operates on Fp
   let smart_cat = (dir, file) => {
     switch (Fp.absoluteCurrentPlatform(dir)) {
-    | None => Filename.concat(dir, file)
+    | None => concat(dir, file)
     | Some(abspath) =>
-      switch (Fp.relative(file)) {
-      | None => Filename.concat(to_string(abspath), file)
-      | Some(relpath) => to_string(Fp.join(abspath, relpath))
+      switch (Fp.testForPath(file)) {
+      | None => concat(dir, file)
+      | Some(Absolute(path)) => to_string(path)
+      | Some(Relative(relpath)) => to_string(Fp.join(abspath, relpath))
       }
     };
   };
@@ -133,9 +174,6 @@ module String = {
       };
     smart_cat(abs_base_path, unit_name);
   };
-
-  // TODO(#216): Replace this with the `get_cwd` that operates on Fp
-  let get_cwd = () => Sys.getcwd();
 };
 
 module Args = {

compiler/src/utils/hacks.js

@@ -1,3 +1,8 @@
+//Provides: os_type
+var os_type = (globalThis.process &&
+    globalThis.process.platform &&
+    globalThis.process.platform == "win32") ? "Win32" : "Unix";
+
 //Provides: unix_opendir
 //Requires: caml_jsstring_of_string
 //Requires: make_unix_err_args, caml_raise_with_args, caml_named_value