Merge branch 'master' into watch-mode

kodek16 · web-flow · commit e8b55b4e0967 · 2018-08-27T11:31:54.000-04:00
diff --git a/bin/main.ml b/bin/main.ml
@@ -758,7 +758,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
diff --git a/src/artifacts.ml b/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
-                  String.sub name ~pos:0 ~len:(String.length name - 4)
+                if Sys.win32 then
+                  Option.value ~default:name
+                    (String.drop_suffix name ~suffix:".exe")
                 else
                   name
               in
diff --git a/src/context.ml b/src/context.ml
@@ -178,13 +178,12 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
     >>= fun findlib_config ->
 
     let get_tool_using_findlib_config prog =
-      Option.bind findlib_config ~f:(fun conf ->
-        match Findlib.Config.get conf prog with
-        | None -> None
-        | Some s ->
-          match Filename.analyze_program_name s with
-          | In_path | Relative_to_current_dir -> which s
-          | Absolute -> Some (Path.of_filename_relative_to_initial_cwd s))
+      let open Option.O in
+      findlib_config >>= fun conf ->
+      Findlib.Config.get conf prog >>= fun s ->
+      match Filename.analyze_program_name s with
+      | In_path | Relative_to_current_dir -> which s
+      | Absolute -> Some (Path.of_filename_relative_to_initial_cwd s)
     in
 
     let ocamlc =
diff --git a/src/dsexp/dsexp.ml b/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 ->
diff --git a/src/dune_file.ml b/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 s
+                     Right (String.drop s 1)
                    else
                      Left s)
           ~after:file
@@ -1145,9 +1144,8 @@ module Executables = struct
       let is_ok (_, candidate) =
         compare candidate link_mode = Eq
       in
-      match List.find ~f:is_ok simple_representations with
-      | Some (s, _) -> Some (Dsexp.unsafe_atom_of_string s)
-      | None -> None
+      List.find ~f:is_ok simple_representations
+      |> Option.map ~f:(fun (s, _) -> Dsexp.unsafe_atom_of_string s)
 
     let dgen link_mode =
       match simple_dgen link_mode with
@@ -1288,13 +1286,12 @@ module Executables = struct
           in
           List.map2 names public_names
             ~f:(fun (_, name) (_, pub) ->
-              match pub with
-              | None -> None
-              | Some pub -> Some ({ Install_conf.
-                                    src = name ^ ext
-                                  ; dst = Some pub
-                                  }))
-          |> List.filter_map ~f:(fun x -> x)
+              Option.map pub ~f:(fun pub ->
+                { Install_conf.
+                  src = name ^ ext
+                ; dst = Some pub
+                }))
+          |> List.filter_opt
       in
       match to_install with
       | [] -> begin
diff --git a/src/findlib.ml b/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
-          (String.sub pkg_dir ~pos:1 ~len:(String.length pkg_dir - 1))
+        Path.relative t.stdlib_dir (String.drop pkg_dir 1)
       else if Filename.is_relative pkg_dir then
         Path.relative parent_dir pkg_dir
       else
@@ -305,9 +304,9 @@ let find_and_acknowledge_meta t ~fq_name =
         else
           loop dirs
     | [] ->
-      match String.Map.find t.builtins root_name with
-      | Some meta -> Some (t.stdlib_dir, Path.of_string "<internal>", meta)
-      | None -> None
+      String.Map.find t.builtins root_name
+      |> Option.map ~f:(fun meta ->
+        (t.stdlib_dir, Path.of_string "<internal>", meta))
   in
   match loop t.path with
   | None ->
diff --git a/src/install_rules.ml b/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.sub s ~pos:1 ~len:(String.length s - 1))
+                   String.extract_blank_separated_words (String.drop s 1)
                  with
                  | ["JBUILDER_GEN" | "DUNE_GEN"] ->
                    Format.fprintf ppf "%a@," Meta.pp meta.entries
diff --git a/src/installed_dune_file.ml b/src/installed_dune_file.ml
@@ -4,15 +4,13 @@ let parse_sub_systems ~parsing_context sexps =
   List.filter_map sexps ~f:(fun sexp ->
     let name, ver, data =
       Dsexp.Of_sexp.(parse (triple string (located Syntax.Version.dparse) raw)
-                      parsing_context) sexp
+                       parsing_context) sexp
     in
-    match Sub_system_name.get name with
-    | None ->
-      (* We ignore sub-systems that are not internally known. These
-         correspond to plugins that are not in use in the current
-         workspace. *)
-      None
-    | Some name -> Some (name, (Dsexp.Ast.loc sexp, ver, data)))
+    (* We ignore sub-systems that are not internally known. These
+       correspond to plugins that are not in use in the current
+       workspace. *)
+    Option.map (Sub_system_name.get name) ~f:(fun name ->
+      (name, (Dsexp.Ast.loc sexp, ver, data))))
   |> Sub_system_name.Map.of_list
   |> (function
     | Ok x -> x
diff --git a/src/module.ml b/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
diff --git a/src/ocaml-config/ocaml_config.ml b/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,
-             let len = String.length line - i - 2 in
-             if len < 0 then
-               ""
-             else
-               String.sub line ~pos:(i + 2) ~len)
+            ( String.take line i
+            , String.drop line (i + 2) (* skipping the space *)
+            )
           in
           loop (x :: acc) lines
         | None ->
@@ -264,13 +261,11 @@ module Vars = struct
           fail "Value of %S is neither 'true' neither 'false': %s." var s
 
     let get_int_opt t var =
-      match get_opt t var with
-      | None -> None
-      | Some s ->
+      Option.bind (get_opt t var) ~f:(fun s ->
         match int_of_string s with
         | x -> Some x
         | exception _ ->
-          fail "Value of %S is not an integer: %s." var s
+          fail "Value of %S is not an integer: %s." var s)
 
     let get_words t var =
       match get_opt t var with
diff --git a/src/ocamldep.ml b/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 ->
-      let basename =
-        String.sub line ~pos:0 ~len:i
-        |> Filename.basename
-      in
+    | Some (basename, deps) ->
+      let basename = Filename.basename basename in
       if basename <> Path.basename file then invalid ();
       let deps =
-        String.extract_blank_separated_words
-          (String.sub line ~pos:(i + 1) ~len:(String.length line - (i + 1)))
+        String.extract_blank_separated_words deps
         |> parse_module_names ~unit ~modules
       in
-      (match lib_interface_module with
-       | None -> ()
-       | Some (m : Module.t) ->
-         let open Module.Name.Infix in
-         if unit.name <> m.name && not (is_alias_module cctx unit) &&
-            List.exists deps ~f:(fun x -> Module.name x = m.name) then
-           die "Module %a in directory %s depends on %a.\n\
-                This doesn't make sense to me.\n\
-                \n\
-                %a is the main module of the library and is \
-                the only module exposed \n\
-                outside of the library. Consequently, it should \
-                be the one depending \n\
-                on all the other modules in the library."
-             Module.Name.pp unit.name (Path.to_string dir)
-             Module.Name.pp m.name
-             Module.Name.pp m.name);
+      Option.iter lib_interface_module ~f:(fun (m : Module.t) ->
+        let open Module.Name.Infix in
+        if unit.name <> m.name && not (is_alias_module cctx unit) &&
+           List.exists deps ~f:(fun x -> Module.name x = m.name) then
+          die "Module %a in directory %s depends on %a.\n\
+               This doesn't make sense to me.\n\
+               \n\
+               %a is the main module of the library and is \
+               the only module exposed \n\
+               outside of the library. Consequently, it should \
+               be the one depending \n\
+               on all the other modules in the library."
+            Module.Name.pp unit.name (Path.to_string dir)
+            Module.Name.pp m.name
+            Module.Name.pp m.name);
       match alias_module with
       | None -> deps
       | Some m -> m :: deps
diff --git a/src/process.ml b/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 after = String.sub s ~pos:prog_end ~len:(len - prog_end) in
+      let before = String.take s prog_start 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
@@ -260,7 +260,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
   close_std_output close_stdout;
   close_std_output close_stderr;
   Scheduler.wait_for_process pid
-  >>| fun status ->
+  >>| fun exit_status ->
   let output =
     match output_filename with
     | None -> ""
@@ -273,13 +273,10 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
       else
         s
   in
-  Log.command (Scheduler.log scheduler)
-    ~command_line:command_line
-    ~output:output
-    ~exit_status:status;
+  Log.command (Scheduler.log scheduler) ~command_line ~output ~exit_status;
   let _, progname, _ = Fancy.split_prog prog in
   let print fmt = Errors.kerrf ~f:(Scheduler.print scheduler) fmt in
-  match status with
+  match exit_status with
   | WEXITED n when code_is_ok ok_codes n ->
     if display = Verbose then begin
       if output <> "" then
diff --git a/src/scheduler.ml b/src/scheduler.ml
@@ -174,7 +174,7 @@ let prepare ?(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
diff --git a/src/scope.ml b/src/scope.ml
@@ -77,19 +77,17 @@ module DB = struct
     let public_libs =
       let public_libs =
         List.filter_map internal_libs ~f:(fun (_dir, lib) ->
-          match lib.public with
-          | None -> None
-          | Some p -> Some (Dune_file.Public_lib.name p, lib.project))
+          Option.map lib.public ~f:(fun p ->
+            (Dune_file.Public_lib.name p, lib.project)))
         |> String.Map.of_list
         |> function
         | Ok x -> x
         | Error (name, _, _) ->
           match
             List.filter_map internal_libs ~f:(fun (_dir, lib) ->
-              match lib.public with
-              | None   -> None
-              | Some p -> Option.some_if (name = Dune_file.Public_lib.name p)
-                            lib.buildable.loc)
+              Option.bind lib.public ~f:(fun p ->
+                Option.some_if (name = Dune_file.Public_lib.name p)
+                  lib.buildable.loc))
           with
           | [] | [_] -> assert false
           | loc1 :: loc2 :: _ ->
diff --git a/src/stdune/filename.ml b/src/stdune/filename.ml
@@ -37,21 +37,18 @@ let extension_start =
 
 let split_extension fn =
   let i = extension_start fn in
-  (String.sub fn ~pos:0 ~len:i,
-   String.sub fn ~pos:i ~len:(String.length fn - i))
+  String.split_n fn i
 
 let split_extension_after_dot fn =
   let i = extension_start fn + 1 in
   let len = String.length fn in
   if i > len then
     (fn, "")
   else
-    (String.sub fn ~pos:0 ~len:i,
-     String.sub fn ~pos:i ~len:(String.length fn - i))
+    String.split_n fn i
 
 let extension fn =
-  let i = extension_start fn in
-  String.sub fn ~pos:i ~len:(String.length fn - i)
+  String.drop fn (extension_start fn)
 
 type program_name_kind =
   | In_path
diff --git a/src/stdune/list.ml b/src/stdune/list.ml
@@ -14,6 +14,14 @@ let rec filter_map l ~f =
     | None -> filter_map l ~f
     | Some x -> x :: filter_map l ~f
 
+let rec filter_opt l =
+  match l with
+  | [] -> []
+  | x :: l ->
+    match x with
+    | None -> filter_opt l
+    | Some x -> x :: filter_opt l
+
 let filteri l ~f =
   let rec filteri l i =
     match l with
diff --git a/src/stdune/list.mli b/src/stdune/list.mli
@@ -6,6 +6,8 @@ val is_empty : _ t -> bool
 
 val filter_map : 'a t -> f:('a -> 'b option) -> 'b t
 
+val filter_opt : 'a option t -> 'a t
+
 val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t
 
 val concat_map : 'a t -> f:('a -> 'b t) -> 'b t
diff --git a/src/stdune/path.ml b/src/stdune/path.ml
diff --git a/src/stdune/pp.ml b/src/stdune/pp.ml
diff --git a/src/stdune/string.ml b/src/stdune/string.ml
diff --git a/src/stdune/string.mli b/src/stdune/string.mli
diff --git a/src/watermarks.ml b/src/watermarks.ml
diff --git a/test/unit-tests/dune b/test/unit-tests/dune
diff --git a/test/unit-tests/string.mlt b/test/unit-tests/string.mlt
