Symbolic Paths

bin/main.ml

@@ -22,6 +22,7 @@ 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
@@ -36,7 +37,7 @@ let set_common c ~targets =
   Clflags.capture_outputs := c.capture_outputs;
   if c.root <> Filename.current_dir_name then
     Sys.chdir c.root;
-  Clflags.workspace_root := Sys.getcwd ();
+  Clflags.workspace_root := Path.External.cwd ();
   Clflags.diff_command := c.diff_command;
   Clflags.auto_promote := c.auto_promote;
   Clflags.force := c.force;
@@ -45,7 +46,9 @@ let set_common c ~targets =
       [ ["dune"; "external-lib-deps"; "--missing"]
       ; c.orig_args
       ; targets
-      ]
+      ];
+  Path.set_root !Clflags.workspace_root;
+  Path.set_build_dir (Path.Kind.of_string c.build_dir)
 
 let restore_cwd_and_execve common prog argv env =
   let env = Env.to_unix env in
@@ -224,7 +227,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 +285,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 +524,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 +551,7 @@ let common =
         $ merged_options
         $ x
         $ display
+        $ build_dir
        )
 
 let installed_libraries =
@@ -593,7 +608,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 +665,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 +675,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 +1284,8 @@ let utop =
     ; `Blocks help_secs
     ] in
   let go common dir ctx_name args =
+    set_common common ~targets:[dir];
     let utop_target = dir |> Path.of_string |> Utop.utop_exe |> Path.to_string in
-    set_common 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/build_interpret.ml

@@ -87,7 +87,7 @@ let static_deps t ~all_targets ~file_tree =
               (* diml: we should probably warn in this case as well *)
               ()
           end;
-          state := G_evaluated (Path.Set.to_list result);
+          state := G_evaluated (Path.Set.to_alpha_list result);
           let action_deps = Path.Set.union result acc.action_deps in
           { acc with action_deps }
       end

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
@@ -389,7 +389,7 @@ type t =
   }
 
 let string_of_paths set =
-  Path.Set.to_list set
+  Path.Set.to_alpha_list set
   |> List.map ~f:(fun p -> sprintf "- %s"
                              (Path.to_string_maybe_quoted
                                 (Path.drop_optional_build_context p)))
@@ -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 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"
 
@@ -713,15 +709,16 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
     >>= fun (action, dyn_deps) ->
     make_local_parent_dirs t targets ~map_path:(fun x -> x);
     let all_deps = Path.Set.union static_deps dyn_deps in
-    let all_deps_as_list = Path.Set.to_list all_deps in
-    let targets_as_list  = Path.Set.to_list targets  in
+    let all_deps_as_list = Path.Set.to_alpha_list all_deps in
+    let targets_as_list  = Path.Set.to_alpha_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
@@ -1191,7 +1188,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
@@ -1483,7 +1480,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

@@ -1,9 +1,11 @@
+open Stdune
+
 (*let ocaml_comp_flags = ref ["-g"]*)
 let g = ref true
 let debug_findlib = ref false
 let warnings = ref "-40"
 let debug_dep_path = ref false
-let workspace_root = ref "."
+let workspace_root = ref Path.External.initial_cwd
 let external_lib_deps_hint = ref []
 let capture_outputs = ref true
 let debug_backtraces = ref false

src/clflags.mli

@@ -1,3 +1,5 @@
+open Stdune
+
 (** Command line flags *)
 
 (** Compilation flags for OCaml files *)
@@ -16,7 +18,7 @@ val debug_findlib : bool ref
 val warnings : string ref
 
 (** The path to the workspace root *)
-val workspace_root : string ref
+val workspace_root : Path.External.t 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,7 @@ 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.absolute (if Sys.win32 then "nul" else "/dev/null")
 
 let jbuilder_keep_fname = ".jbuilder-keep"
 
@@ -108,7 +108,7 @@ let t =
             })
 
 let user_config_file =
-  Path.relative (Path.of_string Xdg.config_dir) "dune/config"
+  Path.relative (Path.absolute 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,8 @@ 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.absolute stdout_fn) in
+  let stderr = Io.read_file (Path.absolute 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 +237,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.absolute c_fname) code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
   let run_ok args =
@@ -267,7 +267,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.absolute c_fname) code;
   logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
   let run_ok args =
@@ -284,7 +284,7 @@ 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.absolute 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 +413,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.absolute tmp_fname) lines;
     Sys.rename tmp_fname fname
 end
 
@@ -479,7 +479,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)
 

src/dune_project.ml

@@ -67,7 +67,7 @@ end = struct
       None
 
   let anonymous path =
-    if Path.is_local path then
+    if Path.is_managed path then
       Some (Anonymous path)
     else
       None
@@ -107,7 +107,7 @@ end = struct
              |> List.tl
              |> String.concat ~sep:"/")
         in
-        if not (Path.is_local p) then invalid s;
+        if not (Path.is_managed p) then invalid s;
         Anonymous p
       | _ when validate s -> Named s
       | _ -> invalid s