Symbolic Paths

bin/main.ml

@@ -22,21 +22,25 @@ type common =
   ; auto_promote          : bool
   ; force                 : bool
   ; ignore_promoted_rules : bool
+  ; build_dir             : string
   ; (* Original arguments for the external-lib-deps hint *)
     orig_args             : string list
   ; config                : Config.t
   }
 
 let prefix_target common s = common.target_prefix ^ s
 
-let set_common c ~targets =
+let set_dirs c =
+  if c.root <> Filename.current_dir_name then
+    Sys.chdir c.root;
+  Path.set_root (Path.External.cwd ());
+  Path.set_build_dir (Path.Kind.of_string c.build_dir)
+
+let set_common_other c ~targets =
   Clflags.debug_dep_path := c.debug_dep_path;
   Clflags.debug_findlib := c.debug_findlib;
   Clflags.debug_backtraces := c.debug_backtraces;
   Clflags.capture_outputs := c.capture_outputs;
-  if c.root <> Filename.current_dir_name then
-    Sys.chdir c.root;
-  Clflags.workspace_root := Sys.getcwd ();
   Clflags.diff_command := c.diff_command;
   Clflags.auto_promote := c.auto_promote;
   Clflags.force := c.force;
@@ -47,6 +51,10 @@ let set_common c ~targets =
       ; targets
       ]
 
+let set_common c ~targets =
+  set_dirs c;
+  set_common_other c ~targets
+
 let restore_cwd_and_execve common prog argv env =
   let env = Env.to_unix env in
   let prog =
@@ -224,7 +232,9 @@ let common =
          orig)
         x
         display
+        build_dir
     =
+    let build_dir = Option.value ~default:"_build" build_dir in
     let root, to_cwd =
       match root with
       | Some dn -> (dn, [])
@@ -280,6 +290,7 @@ let common =
             List.map ~f:Package.Name.of_string (String.split s ~on:',')))
     ; x
     ; config
+    ; build_dir
     }
   in
   let docs = copts_sect in
@@ -518,6 +529,14 @@ let common =
          & info ["x"] ~docs
              ~doc:{|Cross-compile using this toolchain.|})
   in
+  let build_dir =
+    let doc = "Specified build directory. _build if unspecified" in
+    Arg.(value
+         & opt (some string) None
+         & info ["build-dir"] ~docs ~docv:"FILE"
+             ~env:(Arg.env_var ~doc "DUNE_BUILD_DIR")
+             ~doc)
+  in
   let diff_command =
     Arg.(value
          & opt (some string) None
@@ -537,6 +556,7 @@ let common =
         $ merged_options
         $ x
         $ display
+        $ build_dir
        )
 
 let installed_libraries =
@@ -593,7 +613,7 @@ let resolve_package_install setup pkg =
           |> List.map ~f:Package.Name.to_string))
 
 let target_hint (setup : Main.setup) path =
-  assert (Path.is_local path);
+  assert (Path.is_managed path);
   let sub_dir = Option.value ~default:path (Path.parent path) in
   let candidates = Build_system.all_targets setup.build_system in
   let candidates =
@@ -650,7 +670,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
           check_path path;
           if Path.is_root path then
             die "@@ on the command line must be followed by a valid alias name"
-          else if not (Path.is_local path) then
+          else if not (Path.is_managed path) then
             die "@@ on the command line must be followed by a relative path"
           else
             Ok [Alias_rec path]
@@ -660,7 +680,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
           let can't_build path =
             Error (path, target_hint setup path);
           in
-          if not (Path.is_local path) then
+          if not (Path.is_managed path) then
             Ok [File path]
           else if Path.is_in_build_dir path then begin
             if Build_system.is_target setup.build_system path then
@@ -1269,8 +1289,9 @@ let utop =
     ; `Blocks help_secs
     ] in
   let go common dir ctx_name args =
+    set_dirs common;
     let utop_target = dir |> Path.of_string |> Utop.utop_exe |> Path.to_string in
-    set_common common ~targets:[utop_target];
+    set_common_other common ~targets:[utop_target];
     let log = Log.create common in
     let (build_system, context, utop_path) =
       (Main.setup ~log common >>= fun setup ->

src/action.ml

@@ -358,7 +358,7 @@ module Unexpanded = struct
     | List _ -> t sexp
 
   let check_mkdir loc path =
-    if not (Path.is_local path) then
+    if not (Path.is_managed path) then
       Loc.fail loc
         "(mkdir ...) is not supported for paths outside of the workspace:\n\
         \  %a\n"
@@ -849,20 +849,13 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
     Path.rm_rf path;
     Fiber.return ()
   | Mkdir path ->
-    (match Path.kind path with
-     | External _ ->
-       (* Internally we make sure never to do that, and [Unexpanded.*expand] check that *)
-       Exn.code_error
-         "(mkdir ...) is not supported for paths outside of the workspace"
-         [ "mkdir", Path.sexp_of_t path ]
-     | Local path ->
-       Path.Local.mkdir_p path);
+    Path.mkdir_p path;
     Fiber.return ()
   | Digest_files paths ->
     let s =
       let data =
         List.map paths ~f:(fun fn ->
-          (fn, Utils.Cached_digest.file fn))
+          (Path.to_string fn, Utils.Cached_digest.file fn))
       in
       Digest.string
         (Marshal.to_string data [])
@@ -936,7 +929,7 @@ let exec ~targets ~context t =
 let sandbox t ~sandboxed ~deps ~targets =
   Progn
     [ Progn (List.filter_map deps ~f:(fun path ->
-        if Path.is_local path then
+        if Path.is_managed path then
           Some (Ast.Symlink (path, sandboxed path))
         else
           None))
@@ -946,7 +939,7 @@ let sandbox t ~sandboxed ~deps ~targets =
         ~f_path:(fun ~dir:_ p -> sandboxed p)
         ~f_program:(fun ~dir:_ x -> Result.map x ~f:sandboxed)
     ; Progn (List.filter_map targets ~f:(fun path ->
-        if Path.is_local path then
+        if Path.is_managed path then
           Some (Ast.Rename (sandboxed path, path))
         else
           None))

src/artifacts.ml

@@ -53,7 +53,7 @@ let create (context : Context.t) ~public_libs l ~f =
 
 let binary t ?hint name =
   if not (Filename.is_relative name) then
-    Ok (Path.absolute name)
+    Ok (Path.of_filename_relative_to_initial_cwd name)
   else
     match String.Map.find t.local_bins name with
     | Some path -> Ok path

src/bin.ml

@@ -7,7 +7,7 @@ let path_sep =
     ':'
 
 let parse_path ?(sep=path_sep) s =
-  List.map (String.split s ~on:sep) ~f:Path.absolute
+  List.map (String.split s ~on:sep) ~f:Path.of_filename_relative_to_initial_cwd
 
 let path =
   match Env.get Env.initial "PATH" with

src/build_system.ml

@@ -373,7 +373,7 @@ type t =
        [(deps (filename + contents), targets (filename only), action)] *)
     trace       : (Path.t, Digest.t) Hashtbl.t
   ; file_tree   : File_tree.t
-  ; mutable local_mkdirs : Path.Local.Set.t
+  ; mutable local_mkdirs : Path.Set.t
   ; mutable dirs : (Path.t, Dir_status.t) Hashtbl.t
   ; mutable gen_rules :
       (dir:Path.t -> string list -> extra_sub_directories_to_keep) String.Map.t
@@ -406,7 +406,7 @@ let get_dir_status t ~dir =
     else if dir = Path.build_dir then
       (* Not allowed to look here *)
       Dir_status.Loaded Path.Set.empty
-    else if not (Path.is_local dir) then
+    else if not (Path.is_managed dir) then
       Dir_status.Loaded
         (match Path.readdir_unsorted dir with
          | exception _ -> Path.Set.empty
@@ -601,24 +601,20 @@ let clear_targets_digests_after_rule_execution targets =
 
 let make_local_dirs t paths =
   Path.Set.iter paths ~f:(fun path ->
-    match Path.kind path with
-    | Local path ->
-      if not (Path.Local.Set.mem t.local_mkdirs path) then begin
-        Path.Local.mkdir_p path;
-        t.local_mkdirs <- Path.Local.Set.add t.local_mkdirs path
-      end
-    | _ -> ())
+    if Path.is_managed path && not (Path.Set.mem t.local_mkdirs path) then begin
+      Path.mkdir_p path;
+      t.local_mkdirs <- Path.Set.add t.local_mkdirs path
+    end)
 
 let make_local_parent_dirs t paths ~map_path =
   Path.Set.iter paths ~f:(fun path ->
-    match Path.kind (map_path path) with
-    | Local path when not (Path.Local.is_root path) ->
-      let parent = Path.Local.parent path in
-      if not (Path.Local.Set.mem t.local_mkdirs parent) then begin
-        Path.Local.mkdir_p parent;
-        t.local_mkdirs <- Path.Local.Set.add t.local_mkdirs parent
-      end
-    | _ -> ())
+    let path = map_path path in
+    if Path.is_managed path then (
+      Option.iter (Path.parent path) ~f:(fun parent ->
+        if not (Path.Set.mem t.local_mkdirs parent) then begin
+          Path.mkdir_p parent;
+          t.local_mkdirs <- Path.Set.add t.local_mkdirs parent
+        end)))
 
 let sandbox_dir = Path.relative Path.build_dir ".sandbox"
 
@@ -717,11 +713,12 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
     let targets_as_list  = Path.Set.to_list targets  in
     let hash =
       let trace =
-        (List.map all_deps_as_list ~f:(fun fn ->
-           (fn, Utils.Cached_digest.file fn)),
-         targets_as_list,
-         Option.map context ~f:(fun c -> c.name),
-         action)
+        ( all_deps_as_list
+          |> List.map ~f:(fun fn ->
+            (Path.to_string fn, Utils.Cached_digest.file fn)),
+          List.map targets_as_list ~f:Path.to_string,
+          Option.map context ~f:(fun c -> c.name),
+          Action.for_shell action)
       in
       Digest.string (Marshal.to_string trace [])
     in
@@ -760,7 +757,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
           | Some sandbox_dir ->
             Path.rm_rf sandbox_dir;
             let sandboxed path =
-              if Path.is_local path then
+              if Path.is_managed path then
                 Path.append sandbox_dir path
               else
                 path
@@ -1179,7 +1176,7 @@ let create ~contexts ~file_tree ~hook =
     ; files      = Hashtbl.create 1024
     ; packages   = Hashtbl.create 1024
     ; trace      = Trace.load ()
-    ; local_mkdirs = Path.Local.Set.empty
+    ; local_mkdirs = Path.Set.empty
     ; dirs       = Hashtbl.create 1024
     ; load_dir_stack = []
     ; file_tree
@@ -1473,7 +1470,7 @@ let get_collector t ~dir =
          "Build_system.get_collector called on source directory"
        else if dir = Path.build_dir then
          "Build_system.get_collector called on build_dir"
-       else if not (Path.is_local dir) then
+       else if not (Path.is_managed dir) then
          "Build_system.get_collector called on external directory"
        else
          "Build_system.get_collector called on closed directory")

src/clflags.ml

@@ -3,7 +3,6 @@ let g = ref true
 let debug_findlib = ref false
 let warnings = ref "-40"
 let debug_dep_path = ref false
-let workspace_root = ref "."
 let external_lib_deps_hint = ref []
 let capture_outputs = ref true
 let debug_backtraces = ref false

src/clflags.mli

@@ -15,9 +15,6 @@ val debug_findlib : bool ref
 (** Compiler warnings *)
 val warnings : string ref
 
-(** The path to the workspace root *)
-val workspace_root : string ref
-
 (** The command line for "Hint: try: jbuilder external-lib-deps ..." *)
 val external_lib_deps_hint : string list ref
 

src/config.ml

@@ -15,7 +15,9 @@ let local_install_lib_dir ~context ~package =
     (Path.relative (local_install_dir ~context) "lib")
     package
 
-let dev_null = Path.of_string (if Sys.win32 then "nul" else "/dev/null")
+let dev_null =
+  Path.of_filename_relative_to_initial_cwd
+    (if Sys.win32 then "nul" else "/dev/null")
 
 let jbuilder_keep_fname = ".jbuilder-keep"
 
@@ -108,7 +110,8 @@ let t =
             })
 
 let user_config_file =
-  Path.relative (Path.of_string Xdg.config_dir) "dune/config"
+  Path.relative (Path.of_filename_relative_to_initial_cwd Xdg.config_dir)
+    "dune/config"
 
 let load_config_file p =
   t (Io.Sexp.load_many_as_one p)

src/configurator/v1.ml

@@ -142,8 +142,12 @@ let run t ~dir cmd =
       (Filename.quote stdout_fn)
       (Filename.quote stderr_fn)
   in
-  let stdout = Io.read_file (Path.of_string stdout_fn) in
-  let stderr = Io.read_file (Path.of_string stderr_fn) in
+  let stdout =
+    Io.read_file (Path.of_filename_relative_to_initial_cwd stdout_fn)
+  in
+  let stderr =
+    Io.read_file (Path.of_filename_relative_to_initial_cwd stderr_fn)
+  in
   logf t "-> process exited with code %d" exit_code;
   logf t "-> stdout:";
   List.iter (String.split_lines stdout) ~f:(logf t " | %s");
@@ -237,7 +241,7 @@ let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
   let c_fname = base ^ ".c" in
   let obj_fname = base ^ t.ext_obj in
   let exe_fname = base ^ ".exe" in
-  Io.write_file (Path.of_string c_fname) code;
+  Io.write_file (Path.of_filename_relative_to_initial_cwd c_fname) code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
   let run_ok args =
@@ -267,7 +271,7 @@ let compile_c_prog t ?(c_flags=[]) code =
   let base = dir ^/ "test" in
   let c_fname = base ^ ".c" in
   let obj_fname = base ^ t.ext_obj in
-  Io.write_file (Path.of_string c_fname) code;
+  Io.write_file (Path.of_filename_relative_to_initial_cwd c_fname) code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
   let run_ok args =
@@ -284,7 +288,10 @@ let compile_c_prog t ?(c_flags=[]) code =
                 ]
               ])
   in
-  if ok then Ok (Path.of_string obj_fname) else Error ()
+  if ok then
+    Ok (Path.of_filename_relative_to_initial_cwd obj_fname)
+  else
+    Error ()
 
 let c_test t ?c_flags ?link_flags code =
   match compile_and_link_c_prog t ?c_flags ?link_flags code with
@@ -413,7 +420,7 @@ const char *s%i = "BEGIN-%i-false-END";
     logf t "writing header file %s" fname;
     List.iter lines ~f:(logf t " | %s");
     let tmp_fname = fname ^ ".tmp" in
-    Io.write_lines (Path.of_string tmp_fname) lines;
+    Io.write_lines (Path.of_filename_relative_to_initial_cwd tmp_fname) lines;
     Sys.rename tmp_fname fname
 end
 
@@ -479,7 +486,7 @@ module Pkg_config = struct
 end
 
 let write_flags fname s =
-  let path = Path.of_string fname in
+  let path = Path.in_source fname in
   let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in
   Io.write_file path (Usexp.to_string sexp)