From 46d74e1a965e30b51d5ebf666d371c3ad20c3f64 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 3 May 2018 21:22:45 +0700 Subject: [PATCH 1/3] Implement Path.explode_exn in terms of Path.explode --- src/stdune/path.ml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/stdune/path.ml b/src/stdune/path.ml index da114a6b..7477c738 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -418,13 +418,10 @@ let explode t = None let explode_exn t = - if is_root t then - [] - else if is_local t then - String.split t ~on:'/' - else - Exn.code_error "Path.explode_exn" - ["path", Sexp.atom_or_quoted_string t] + match explode t with + | Some s -> s + | None -> Exn.code_error "Path.explode_exn" + ["path", Sexp.atom_or_quoted_string t] let exists t = try Sys.file_exists (to_string t) From 92b351de305d8fa5055762d162c5e4569e7ce217 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 3 May 2018 21:28:32 +0700 Subject: [PATCH 2/3] Small refactoring to call Path.absolute one less time --- src/context.ml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/context.ml b/src/context.ml index 65602036..f8ac6f7f 100644 --- a/src/context.ml +++ b/src/context.ml @@ -149,12 +149,10 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () = the contents of the variable, but "ocamlfind printconf conf" still prints the configuration file set at the configuration time of ocamlfind, sigh... *) - match Env.get env "OCAMLFIND_CONF" with - | Some s -> Fiber.return (Path.absolute s) - | None -> - Process.run_capture_line ~env Strict - fn ["printconf"; "conf"] - >>| Path.absolute) + (match Env.get env "OCAMLFIND_CONF" with + | Some s -> Fiber.return s + | None -> Process.run_capture_line ~env Strict fn ["printconf"; "conf"]) + >>| Path.absolute) in let create_one ~name ~implicit ?findlib_toolchain ?host ~merlin () = From c563fc1db84a612593357aced3f22b233932ab00 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 3 May 2018 22:15:25 +0700 Subject: [PATCH 3/3] Re-implement many path functions using kind This will make it easier to port them to symbolic paths as this check is also necessary there. --- src/stdune/path.ml | 90 +++++++++++++++++++++++----------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 7477c738..b3852596 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -279,31 +279,32 @@ let absolute fn = fn let to_absolute_filename t ~root = - if is_local t then begin + match kind t with + | Local t -> assert (not (Filename.is_relative root)); - Filename.concat root (to_string t) - end else - t + Filename.concat root (Local.to_string t) + | External t -> t let reach t ~from = - match is_local t, is_local from with - | false, _ -> t - | true, false -> + match kind t, kind from with + | External _, _ -> t + | Local _, External _ -> Exn.code_error "Path.reach called with invalid combination" [ "t" , sexp_of_t t ; "from", sexp_of_t from ] - | true, true -> Local.reach t ~from + | Local t, Local from -> + Local.reach t ~from let reach_for_running t ~from = - match is_local t, is_local from with - | false, _ -> t - | true, false -> + match kind t, kind from with + | External _, _ -> t + | Local _, External _ -> Exn.code_error "Path.reach_for_running called with invalid combination" [ "t" , sexp_of_t t ; "from", sexp_of_t from ] - | true, true -> + | Local t, Local from -> let s = Local.reach t ~from in if String.is_prefix s ~prefix:"../" then s @@ -311,46 +312,46 @@ let reach_for_running t ~from = "./" ^ s let descendant t ~of_ = - if is_local t && is_local of_ then - Local.descendant t ~of_ - else - None + match kind t, kind of_ with + | Local t, Local of_ -> Local.descendant t ~of_ + | _, _ -> None let is_descendant t ~of_ = - if is_local t && is_local of_ then - Local.is_descendant t ~of_ - else - false + match kind t, kind of_ with + | Local t, Local of_ -> Local.is_descendant t ~of_ + | _, _ -> false let append a b = - if not (is_local b) then + match kind b with + | External _ -> Exn.code_error "Path.append called with non-local second path" [ "a", sexp_of_t a ; "b", sexp_of_t b - ]; - if is_local a then - Local.append a b - else - Filename.concat a b + ] + | Local b -> + begin match kind a with + | Local a -> Local.append a b + | External a -> Filename.concat a b + end let basename t = - if is_local t then - Local.basename t - else - Filename.basename t + match kind t with + | Local t -> Local.basename t + | External t -> Filename.basename t let parent t = - if is_local t then - Local.parent t - else - Filename.dirname t + match kind t with + | Local t -> Local.parent t + | External t -> Filename.dirname t let build_prefix = "_build/" let build_dir = "_build" let is_in_build_dir t = - String.is_prefix t ~prefix:build_prefix + match kind t with + | Local t -> String.is_prefix t ~prefix:build_prefix + | External _ -> false let is_in_source_tree t = is_local t && not (is_in_build_dir t) @@ -399,23 +400,22 @@ let drop_optional_build_context t = | Some (_, t) -> t let split_first_component t = - if is_local t && not (is_root t)then - match String.index t '/' with + match kind t, is_root t with + | Local t, false -> + begin match String.index t '/' with | None -> Some (t, root) | Some i -> Some (String.sub t ~pos:0 ~len:i, String.sub t ~pos:(i + 1) ~len:(String.length t - i - 1)) - else - None + end + | _, _ -> None let explode t = - if is_root t then - Some [] - else if is_local t then - Some (String.split t ~on:'/') - else - None + match kind t with + | Local "" -> Some [] + | Local s -> Some (String.split s ~on:'/') + | External _ -> None let explode_exn t = match explode t with