merlin: avoid touching case of filename

bin/ocaml/ocaml_merlin.ml

@@ -50,13 +50,10 @@ end = struct
      Cygwin environment both paths are lowarcased before the comparison *)
   let make_relative_to_root p =
     let p = Path.to_absolute_filename p in
-    let prefix, p =
-      let prefix = Path.(to_absolute_filename root) in
-      if Sys.win32 || Sys.cygwin then
-        (String.lowercase_ascii prefix, String.lowercase_ascii p)
-      else (prefix, p)
-    in
-    String.drop_prefix ~prefix p
+    let prefix = Path.(to_absolute_filename root) in
+    (if Sys.win32 || Sys.cygwin then String.Caseless.drop_prefix
+    else String.drop_prefix)
+      ~prefix p
     (* After dropping the prefix we need to remove the leading path separator *)
     |> Option.map ~f:(fun s -> String.drop s 1)
 

otherlibs/stdune/src/string.ml

@@ -82,6 +82,50 @@ let drop_suffix_if_exists s ~suffix =
   | None -> s
   | Some s -> s
 
+module Caseless = struct
+  let rec check_prefix s ~prefix len i =
+    i = len
+    || Char.lowercase_ascii s.[i] = Char.lowercase_ascii s.[i]
+       && check_prefix s ~prefix len (i + 1)
+
+  let rec check_suffix s ~suffix suffix_len offset i =
+    i = suffix_len
+    || Char.lowercase_ascii s.[offset + i] = Char.lowercase_ascii s.[i]
+       && check_suffix s ~suffix suffix_len offset (i + 1)
+
+  let is_prefix s ~prefix =
+    let len = length s in
+    let prefix_len = length prefix in
+    len >= prefix_len && check_prefix s ~prefix prefix_len 0
+
+  let is_suffix s ~suffix =
+    let len = length s in
+    let suffix_len = length suffix in
+    len >= suffix_len && check_suffix s ~suffix suffix_len (len - suffix_len) 0
+
+  let drop_prefix s ~prefix =
+    if is_prefix s ~prefix then
+      if length s = length prefix then Some ""
+      else Some (sub s ~pos:(length prefix) ~len:(length s - length prefix))
+    else None
+
+  let drop_prefix_if_exists s ~prefix =
+    match drop_prefix s ~prefix with
+    | None -> s
+    | Some s -> s
+
+  let drop_suffix s ~suffix =
+    if is_suffix s ~suffix then
+      if length s = length suffix then Some ""
+      else Some (sub s ~pos:0 ~len:(length s - length suffix))
+    else None
+
+  let drop_suffix_if_exists s ~suffix =
+    match drop_suffix s ~suffix with
+    | None -> s
+    | Some s -> s
+end
+
 let extract_words s ~is_word_char =
   let rec skip_blanks i =
     if i = length s then []

otherlibs/stdune/src/string.mli

@@ -37,6 +37,18 @@ val drop_suffix : t -> suffix:t -> t option
 
 val drop_suffix_if_exists : t -> suffix:t -> t
 
+module Caseless : sig
+  (** Case-insensitive matching semantics. *)
+
+  val drop_prefix : t -> prefix:t -> t option
+
+  val drop_prefix_if_exists : t -> prefix:t -> t
+
+  val drop_suffix : t -> suffix:t -> t option
+
+  val drop_suffix_if_exists : t -> suffix:t -> t
+end
+
 (** These only change ASCII characters *)
 val capitalize : t -> t