diff --git a/bin/main.ml b/bin/main.ml index 2cd5a674..3c6c6e74 100644 --- a/bin/main.ml +++ b/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 diff --git a/src/artifacts.ml b/src/artifacts.ml index 95904317..ede53bb1 100644 --- 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 index 2082bcdd..10e1cee5 100644 --- 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 index cd56265a..f393693c 100644 --- 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 index d9f89c76..2944d8b7 100644 --- 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 index 9c3ceaad..027adaa3 100644 --- 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 "", meta) - | None -> None + String.Map.find t.builtins root_name + |> Option.map ~f:(fun meta -> + (t.stdlib_dir, Path.of_string "", meta)) in match loop t.path with | None -> diff --git a/src/install_rules.ml b/src/install_rules.ml index 5102f77e..bc2c4a1c 100644 --- 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 index 89ad3a72..a3fa496f 100644 --- 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 index 645c2ff6..2ea6ad11 100644 --- 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 index 9af769e5..fc577b1c 100644 --- 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 index 09bf7b44..9d60073c 100644 --- 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 index d5af0c1a..d29a0a71 100644 --- 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 diff --git a/src/scheduler.ml b/src/scheduler.ml index d5e617dc..747f69be 100644 --- a/src/scheduler.ml +++ b/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 diff --git a/src/scope.ml b/src/scope.ml index 0b67d28a..6e0b9089 100644 --- 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 index 2679eed5..74e502a5 100644 --- a/src/stdune/filename.ml +++ b/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.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 @@ -46,12 +45,10 @@ let split_extension_after_dot fn = 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 index 0c48614d..404c5fbf 100644 --- 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 index 505b1de0..76d453d6 100644 --- 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 index 0b348525..c277df2f 100644 --- a/src/stdune/path.ml +++ b/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) - , in_source_tree Local.root ) - | Some j -> + Some (t, in_source_tree Local.root ) + | Some (before, after) -> Some - ( String.sub t ~pos:0 ~len:j - , String.sub t ~pos:(j + 1) ~len:(String.length t - j - 1) + ( before + , 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)) - , (String.sub t_str ~pos:(j + 1) ~len:(String.length t_str - j - 1)) + ( in_build_dir (Local.of_string before) + , 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 - , String.sub t ~pos:(i + 1) ~len:(String.length t - i - 1) + ( before + , after |> Local.of_string |> in_source_tree ) end diff --git a/src/stdune/pp.ml b/src/stdune/pp.ml index 8d4ebc16..e7c9df61 100644 --- a/src/stdune/pp.ml +++ b/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 = diff --git a/src/stdune/string.ml b/src/stdune/string.ml index 5816ff03..352b5095 100644 --- a/src/stdune/string.ml +++ b/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,17 @@ 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 + let n = min n len in + ( sub s ~pos:0 ~len:n + , sub s ~pos:n ~len:(len - n) + ) diff --git a/src/stdune/string.mli b/src/stdune/string.mli index 6ba31660..2f5877dd 100644 --- a/src/stdune/string.mli +++ b/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 diff --git a/src/watermarks.ml b/src/watermarks.ml index 1ab915ae..e4c4975d 100644 --- a/src/watermarks.ml +++ b/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 - String.sub version ~pos:1 ~len:(String.length version - 1) - else - version - in + Option.value ~default:version (String.drop_prefix version ~prefix:"v") 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) diff --git a/test/unit-tests/dune b/test/unit-tests/dune index e0abe874..19c82f03 100644 --- a/test/unit-tests/dune +++ b/test/unit-tests/dune @@ -98,3 +98,13 @@ (progn (run %{exe:expect_test.exe} %{t}) (diff? %{t} %{t}.corrected))))) + +(alias + (name runtest) + (deps (:t string.mlt) + (glob_files %{project_root}/src/.dune.objs/*.cmi) + (glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi)) + (action (chdir %{project_root} + (progn + (run %{exe:expect_test.exe} %{t}) + (diff? %{t} %{t}.corrected))))) \ No newline at end of file diff --git a/test/unit-tests/string.mlt b/test/unit-tests/string.mlt new file mode 100644 index 00000000..1960dea9 --- /dev/null +++ b/test/unit-tests/string.mlt @@ -0,0 +1,81 @@ +(* -*- tuareg -*- *) +open! Stdune;; + +Printexc.record_backtrace false;; + +String.take "foobar" 3;; +[%%expect{| +- : unit = () +- : string = "foo" +|}] + +String.take "foobar" 0;; +[%%expect{| +- : string = "" +|}] + +String.take "foo" 10;; +[%%expect{| +- : string = "foo" +|}] + +String.take "" 10;; +[%%expect{| +- : string = "" +|}] + +String.take "" 0;; +[%%expect{| +- : string = "" +|}] + + +String.drop "" 0;; +[%%expect{| +- : string = "" +|}] + +String.drop "foo" 0;; +[%%expect{| +- : string = "foo" +|}] + +String.drop "foo" 5;; +[%%expect{| +- : string = "" +|}] + +String.drop "foobar" 3;; +[%%expect{| +- : string = "bar" +|}] + +String.split_n "foobar" 3;; +[%%expect{| +- : string * string = ("foo", "bar") +|}] + +String.split_n "foobar" 10;; +[%%expect{| +- : string * string = ("foobar", "") +|}] + +String.split_n "foobar" 0;; +[%%expect{| +- : string * string = ("", "foobar") +|}] + +String.split_n "foobar" 6;; +[%%expect{| +- : string * string = ("foobar", "") +|}] + +String.split_n "" 0;; +[%%expect{| +- : string * string = ("", "") +|}] + +String.split_n "" 10;; +[%%expect{| +- : string * string = ("", "") +|}]