Introduce String.{take,drop,split_n}

This simplifies quite a lot of code

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

bin/main.ml

@@ -695,7 +695,7 @@ let resolve_target common ~(setup : Main.setup) s =
       else
         (1, true)
     in
-    let s = String.sub s ~pos ~len:(String.length s - pos) in
+    let s = String.drop s pos in
     let path = Path.relative Path.root (prefix_target common s) in
     check_path setup.contexts path;
     if Path.is_root path then

src/artifacts.ml

@@ -23,8 +23,9 @@ let create (context : Context.t) ~public_libs l ~f =
                 | None -> Filename.basename src
               in
               let key =
-                if Sys.win32 && Filename.extension name = ".exe" then
+                if Sys.win32 then
-                  String.sub name ~pos:0 ~len:(String.length name - 4)
+                  Option.value ~default:name
+                    (String.drop_suffix name ~suffix:".exe")
                 else
                   name
               in

src/dsexp/dsexp.ml

@@ -557,7 +557,7 @@ module Of_sexp = struct
   let if_paren_colon_form ~then_ ~else_ =
     peek_exn >>= function
     | List (_, Atom (loc, A s) :: _) when String.is_prefix s ~prefix:":" ->
-      let name = String.sub s ~pos:1 ~len:(String.length s - 1) in
+      let name = String.drop s 1 in
       enter
         (junk >>= fun () ->
          then_ >>| fun f ->

src/dune_file.ml

@@ -614,8 +614,7 @@ module Lib_dep = struct
           ~before:(let%map s = string in
                    let len = String.length s in
                    if len > 0 && s.[0] = '!' then
-                     let s = String.sub s ~pos:1 ~len:(len - 1) in
+                     Right (String.drop s 1)
-                     Right s
                    else
                      Left s)
           ~after:file

src/findlib.ml

@@ -200,7 +200,7 @@ let path t = t.path
 let root_package_name s =
   match String.index s '.' with
   | None -> s
-  | Some i -> String.sub s ~pos:0 ~len:i
+  | Some i -> String.take s i
 
 let dummy_package t ~name =
   let dir =
@@ -223,8 +223,7 @@ let parse_package t ~meta_file ~name ~parent_dir ~vars =
     | None | Some "" -> parent_dir
     | Some pkg_dir ->
       if pkg_dir.[0] = '+' || pkg_dir.[0] = '^' then
-        Path.relative t.stdlib_dir
+        Path.relative t.stdlib_dir (String.drop pkg_dir 1)
-          (String.sub pkg_dir ~pos:1 ~len:(String.length pkg_dir - 1))
       else if Filename.is_relative pkg_dir then
         Path.relative parent_dir pkg_dir
       else

src/install_rules.ml

@@ -102,8 +102,7 @@ module Gen(P : Params) = struct
              List.iter template ~f:(fun s ->
                if String.is_prefix s ~prefix:"#" then
                  match
-                   String.extract_blank_separated_words
+                   String.extract_blank_separated_words (String.drop s 1)
-                     (String.sub s ~pos:1 ~len:(String.length s - 1))
                  with
                  | ["JBUILDER_GEN" | "DUNE_GEN"] ->
                    Format.fprintf ppf "%a@," Meta.pp meta.entries

src/installed_dune_file.ml

@@ -6,13 +6,11 @@ let parse_sub_systems ~parsing_context sexps =
       Dsexp.Of_sexp.(parse (triple string (located Syntax.Version.dparse) raw)
                       parsing_context) sexp
     in
-    match Sub_system_name.get name with
+    (* We ignore sub-systems that are not internally known. These
-    | None ->
+       correspond to plugins that are not in use in the current
-      (* We ignore sub-systems that are not internally known. These
+       workspace. *)
-         correspond to plugins that are not in use in the current
+    Option.bind (Sub_system_name.get name) ~f:(fun name ->
-         workspace. *)
+      Some (name, (Dsexp.Ast.loc sexp, ver, data)))
-      None
-    | Some name -> Some (name, (Dsexp.Ast.loc sexp, ver, data)))
   |> Sub_system_name.Map.of_list
   |> (function
     | Ok x -> x

src/module.ml

@@ -72,7 +72,7 @@ let make ?impl ?intf ?obj_name name =
       let fn = Path.basename file.path in
       match String.index fn '.' with
       | None   -> fn
-      | Some i -> String.sub fn ~pos:0 ~len:i
+      | Some i -> String.take fn i
   in
   { name
   ; impl

src/ocaml-config/ocaml_config.ml

@@ -215,12 +215,9 @@ module Vars = struct
         match String.index line ':' with
         | Some i ->
           let x =
-            (String.sub line ~pos:0 ~len:i,
+            ( String.take line i
-             let len = String.length line - i - 2 in
+            , String.drop line (i + 2) (* skipping the space *)
-             if len < 0 then
+            )
-               ""
-             else
-               String.sub line ~pos:(i + 2) ~len)
           in
           loop (x :: acc) lines
         | None ->

src/ocamldep.ml

@@ -90,36 +90,30 @@ let parse_deps cctx ~file ~unit lines =
   match lines with
   | [] | _ :: _ :: _ -> invalid ()
   | [line] ->
-    match String.index line ':' with
+    match String.lsplit2 line ~on:':' with
     | None -> invalid ()
-    | Some i ->
+    | Some (basename, deps) ->
-      let basename =
+      let basename = Filename.basename basename in
-        String.sub line ~pos:0 ~len:i
-        |> Filename.basename
-      in
       if basename <> Path.basename file then invalid ();
       let deps =
-        String.extract_blank_separated_words
+        String.extract_blank_separated_words deps
-          (String.sub line ~pos:(i + 1) ~len:(String.length line - (i + 1)))
         |> parse_module_names ~unit ~modules
       in
-      (match lib_interface_module with
+      Option.iter lib_interface_module ~f:(fun (m : Module.t) ->
-       | None -> ()
+        let open Module.Name.Infix in
-       | Some (m : Module.t) ->
+        if unit.name <> m.name && not (is_alias_module cctx unit) &&
-         let open Module.Name.Infix in
+           List.exists deps ~f:(fun x -> Module.name x = m.name) then
-         if unit.name <> m.name && not (is_alias_module cctx unit) &&
+          die "Module %a in directory %s depends on %a.\n\
-            List.exists deps ~f:(fun x -> Module.name x = m.name) then
+               This doesn't make sense to me.\n\
-           die "Module %a in directory %s depends on %a.\n\
+               \n\
-                This doesn't make sense to me.\n\
+               %a is the main module of the library and is \
-                \n\
+               the only module exposed \n\
-                %a is the main module of the library and is \
+               outside of the library. Consequently, it should \
-                the only module exposed \n\
+               be the one depending \n\
-                outside of the library. Consequently, it should \
+               on all the other modules in the library."
-                be the one depending \n\
+            Module.Name.pp unit.name (Path.to_string dir)
-                on all the other modules in the library."
+            Module.Name.pp m.name
-             Module.Name.pp unit.name (Path.to_string dir)
+            Module.Name.pp m.name);
-             Module.Name.pp m.name
-             Module.Name.pp m.name);
       match alias_module with
       | None -> deps
       | Some m -> m :: deps

src/process.ml

@@ -92,8 +92,8 @@ module Fancy = struct
         | exception _ -> prog_end
         | i -> i
       in
-      let before = String.sub s ~pos:0 ~len:prog_start in
+      let before = String.take s prog_start in
-      let after = String.sub s ~pos:prog_end ~len:(len - prog_end) in
+      let after = String.drop s prog_end in
       let prog = String.sub s ~pos:prog_start ~len:(prog_end - prog_start) in
       before, prog, after
     end

src/scheduler.ml

@@ -169,7 +169,7 @@ let go ?(log=Log.no_log) ?(config=Config.default)
              String.drop_prefix p ~prefix:of_
            with
            | None | Some "" -> None
-           | Some s -> Some (String.sub s ~pos:1 ~len:(String.length s - 1))
+           | Some s -> Some (String.drop s 1)
          in
          match descendant_simple cwd ~of_:initial_cwd with
          | Some s -> s

src/stdune/filename.ml

@@ -37,8 +37,7 @@ let extension_start =
 
 let split_extension fn =
   let i = extension_start fn in
-  (String.sub fn ~pos:0 ~len:i,
+  String.split_n fn i
-   String.sub fn ~pos:i ~len:(String.length fn - i))
 
 let split_extension_after_dot fn =
   let i = extension_start fn + 1 in
@@ -46,12 +45,10 @@ let split_extension_after_dot fn =
   if i > len then
     (fn, "")
   else
-    (String.sub fn ~pos:0 ~len:i,
+    String.split_n fn i
-     String.sub fn ~pos:i ~len:(String.length fn - i))
 
 let extension fn =
-  let i = extension_start fn in
+  String.drop fn (extension_start fn)
-  String.sub fn ~pos:i ~len:(String.length fn - i)
 
 type program_name_kind =
   | In_path

src/stdune/path.ml

@@ -14,7 +14,7 @@ let explode_path =
       component acc path i (i - 1)
   and component acc path end_ i =
     if i < 0 then
-      String.sub path ~pos:0 ~len:(end_ + 1)::acc
+      String.take path (end_ + 1) :: acc
     else if is_dir_sep (String.unsafe_get path i) then
       start
         (String.sub path ~pos:(i + 1) ~len:(end_ - i)::acc)
@@ -180,7 +180,7 @@ end = struct
   let to_list =
     let rec loop t acc i j =
       if i = 0 then
-        String.sub t ~pos:0 ~len:j :: acc
+        String.take t j :: acc
       else
         match t.[i - 1] with
         | '/' -> loop t (String.sub t ~pos:i ~len:(j - i) :: acc) (i - 1) (i - 1)
@@ -201,7 +201,7 @@ end = struct
       let t = to_string t in
       match String.rindex_from t (String.length t - 1) '/' with
       | exception Not_found -> root
-      | i -> make (String.sub t ~pos:0 ~len:i)
+      | i -> make (String.take t i)
 
   let basename t =
     if is_root t then
@@ -322,7 +322,7 @@ end = struct
       let t_len = String.length t in
       if (t_len > of_len && t.[of_len] = '/'
           && String.is_prefix t ~prefix:of_) then
-        Some (make (String.sub t ~pos:(of_len + 1) ~len:(t_len - of_len - 1)))
+        Some (make (String.drop t (of_len + 1)))
       else
         None
 
@@ -722,14 +722,13 @@ let extract_build_context = function
   | In_build_dir p when Local.is_root p -> None
   | In_build_dir t ->
     let t = Local.to_string t in
-    begin match String.index t '/' with
+    begin match String.lsplit2 t ~on:'/' with
     | None ->
-      Some ( String.sub t ~pos:0 ~len:(String.length t)
+      Some (t, in_source_tree Local.root )
-           , in_source_tree Local.root )
+    | Some (before, after) ->
-    | Some j ->
       Some
-        ( String.sub t ~pos:0 ~len:j
+        ( before
-        , String.sub t ~pos:(j + 1) ~len:(String.length t - j - 1)
+        , after
           |> Local.of_string
           |> in_source_tree )
     end
@@ -739,12 +738,12 @@ let extract_build_context_dir = function
   | External _ -> None
   | In_build_dir t ->
     let t_str = Local.to_string t in
-    begin match String.index t_str '/' with
+    begin match String.lsplit2 t_str ~on:'/' with
     | None -> Some (in_build_dir t, in_source_tree Local.root)
-    | Some j ->
+    | Some (before, after) ->
       Some
-        ( in_build_dir (Local.of_string (String.sub t_str ~pos:0 ~len:j))
+        ( in_build_dir (Local.of_string before)
-        , (String.sub t_str ~pos:(j + 1) ~len:(String.length t_str - j - 1))
+        , after
           |> Local.of_string
           |> in_source_tree
         )
@@ -776,12 +775,12 @@ let split_first_component t =
   match kind t, is_root t with
   | Local t, false ->
     let t = Local.to_string t in
-    begin match String.index t '/' with
+    begin match String.lsplit2 t ~on:'/' with
     | None -> Some (t, root)
-    | Some i ->
+    | Some (before, after) ->
       Some
-        ( String.sub t ~pos:0 ~len:i
+        ( before
-        , String.sub t ~pos:(i + 1) ~len:(String.length t - i - 1)
+        , after
           |> Local.of_string
           |> in_source_tree )
     end

src/stdune/pp.ml

@@ -69,7 +69,7 @@ module Renderer = struct
 
     let extract_closing_tag s =
       let pos = 2 + get16 s 0 in
-      String.sub s ~pos ~len:(String.length s - pos)
+      String.drop s pos
 
 
     let rec pp th ppf t =

src/stdune/string.ml

@@ -60,6 +60,15 @@ let drop_prefix s ~prefix =
   else
     None
 
+let drop_suffix s ~suffix =
+  if is_suffix s ~suffix then
+    if length s = length suffix then
+      Some s
+    else
+      Some (sub s ~pos:0 ~len:(length s - length suffix))
+  else
+    None
+
 let extract_words s ~is_word_char =
   let rec skip_blanks i =
     if i = length s then
@@ -230,3 +239,21 @@ let concat ~sep = function
   | [] -> ""
   | [x] -> x
   | xs -> concat ~sep xs
+
+let take s len =
+  sub s ~pos:0 ~len:(min (length s) len)
+
+let drop s n =
+  let len = length s in
+  sub s ~pos:(min n len) ~len:(max (len - n) 0)
+
+let split_n s n =
+  let len = length s in
+  if n > len then
+    Exn.code_error "String.split_n"
+      [ "s", Sexp.Atom s
+      ; "n", Sexp.Atom (string_of_int n)
+      ];
+  ( sub s ~pos:0 ~len:n
+  , sub s ~pos:n ~len:(len - n)
+  )

src/stdune/string.mli

@@ -10,9 +10,14 @@ val is_empty : t -> bool
 val is_prefix : t -> prefix:t -> bool
 val is_suffix : t -> suffix:t -> bool
 
-val drop_prefix : t -> prefix:t -> t option
+val take : t -> int -> t
+val drop : t -> int -> t
+val split_n : t -> int -> t * t
 
-(** These only change ASCII charactes *)
+val drop_prefix : t -> prefix:t -> t option
+val drop_suffix : t -> suffix:t -> t option
+
+(** These only change ASCII characters *)
 val capitalize   : t -> t
 val uncapitalize : t -> t
 val uppercase    : t -> t

src/watermarks.ml

@@ -22,11 +22,7 @@ let is_a_source_file fn =
 let make_watermark_map ~name ~version ~commit =
   let opam_file = Opam_file.load (Path.in_source (name ^ ".opam")) in
   let version_num =
-    if String.is_prefix version ~prefix:"v" then
+    Option.value ~default:version (String.drop_prefix version ~prefix:"v") in
-      String.sub version ~pos:1 ~len:(String.length version - 1)
-    else
-      version
-  in
   let opam_var name sep =
     match Opam_file.get_field opam_file name with
     | None -> Error (sprintf "variable %S not found in opam file" name)