Entirely eliminate Dloc

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/build_interpret.ml

@@ -83,11 +83,11 @@ let static_deps t ~all_targets ~file_tree =
           if Path.Set.is_empty result then begin
             match inspect_path file_tree dir with
             | None ->
-              Dloc.warn loc "Directory %s doesn't exist."
+              Errors.warn loc "Directory %s doesn't exist."
                 (Path.to_string_maybe_quoted
                    (Path.drop_optional_build_context dir))
             | Some Reg ->
-              Dloc.warn loc "%s is not a directory."
+              Errors.warn loc "%s is not a directory."
                 (Path.to_string_maybe_quoted
                    (Path.drop_optional_build_context dir))
             | Some Dir ->

src/build_system.ml

@@ -565,7 +565,7 @@ let add_spec t fn spec ~copy_source =
   | Some (File_spec.T { rule; _ }) ->
     match copy_source, rule.mode with
     | true, (Standard | Not_a_rule_stanza) ->
-      Dloc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
+      Errors.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
                   ~file_tree:t.file_tree)
         "File %s is both generated by a rule and present in the source tree.\n\
          As a result, the rule is currently ignored, however this will become an error \

src/dir_contents.ml

@@ -101,7 +101,7 @@ end = struct
     if missing_intf_only <> [] then begin
       match Ordered_set_lang.loc buildable.modules_without_implementation with
       | None ->
-        Dloc.warn buildable.loc
+        Errors.warn buildable.loc
           "Some modules don't have an implementation.\
            \nYou need to add the following field to this stanza:\
            \n\
@@ -122,7 +122,7 @@ end = struct
           |> List.map ~f:(sprintf "- %s")
           |> String.concat ~sep:"\n"
         in
-        Dloc.warn loc
+        Errors.warn loc
           "The following modules must be listed here as they don't \
            have an implementation:\n\
            %s\n\
@@ -155,7 +155,7 @@ end = struct
       )
     in
     Module.Name.Map.iteri fake_modules ~f:(fun m loc ->
-      Dloc.warn loc "Module %a is excluded but it doesn't exist."
+      Errors.warn loc "Module %a is excluded but it doesn't exist."
         Module.Name.pp m
     );
     check_invalid_module_listing ~buildable:conf ~intf_only ~modules
@@ -442,7 +442,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
             List.sort ~compare
               (b.Buildable.loc :: List.map rest ~f:(fun b -> b.Buildable.loc))
           in
-          Dloc.warn (Loc.in_file b.loc.start.pos_fname)
+          Errors.warn (Loc.in_file b.loc.start.pos_fname)
             "Module %a is used in several stanzas:@\n\
              @[<v>%a@]@\n\
              @[%a@]@\n\

src/dloc.ml

@@ -1,65 +0,0 @@
-open! Stdune
-open Import
-
-include Loc
-
-let in_file = Loc.in_file
-
-let file_line path n =
-  Io.with_file_in ~binary:false path
-    ~f:(fun ic ->
-      for _ = 1 to n - 1 do
-        ignore (input_line ic)
-      done;
-      input_line ic
-    )
-
-let file_lines path ~start ~stop =
-  Io.with_file_in ~binary:true path
-    ~f:(fun ic ->
-      let rec aux acc lnum =
-        if lnum > stop then
-          List.rev acc
-        else if lnum < start then
-          (ignore (input_line ic);
-           aux acc (lnum + 1))
-        else
-          let line = input_line ic in
-          aux ((string_of_int lnum, line) :: acc) (lnum + 1)
-      in
-      aux [] 1
-    )
-
-let print ppf loc =
-  let { Loc.start; stop } = loc in
-  let start_c = start.pos_cnum - start.pos_bol in
-  let stop_c  = stop.pos_cnum  - start.pos_bol in
-  let num_lines = stop.pos_lnum - start.pos_lnum in
-  let pp_file_excerpt pp () =
-    let whole_file = start_c = 0 && stop_c = 0 in
-    if not whole_file then
-      let path = Path.of_string start.pos_fname in
-      if Path.exists path then
-        let line = file_line path start.pos_lnum in
-        if stop_c <= String.length line then
-          let len = stop_c - start_c in
-          Format.fprintf pp "%s\n%*s\n" line
-            stop_c
-            (String.make len '^')
-        else if num_lines <= 10 then
-          let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
-          let last_lnum = Option.map ~f:fst (List.last lines) in
-          let padding_width = Option.value_exn
-                                (Option.map ~f:String.length last_lnum) in
-          List.iter ~f:(fun (lnum, l) ->
-            Format.fprintf pp "%*s: %s\n" padding_width lnum l)
-          lines
-  in
-  Format.fprintf ppf
-    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
-    start.pos_fname start.pos_lnum start_c stop_c
-    pp_file_excerpt ()
-
-let warn t fmt =
-  Errors.kerrf ~f:print_to_console
-    ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t

src/dloc.mli

@@ -1,16 +0,0 @@
-open! Stdune
-
-type t = Loc.t =
-  { start : Lexing.position
-  ; stop  : Lexing.position
-  }
-
-val in_file : string -> t
-
-val none : t
-
-(** Prints "File ..., line ..., characters ...:\n" *)
-val print : Format.formatter -> t -> unit
-
-(** Prints a warning *)
-val warn : t -> ('a, Format.formatter, unit) format -> 'a

src/dune_file.ml

@@ -80,7 +80,7 @@ end = struct
     match res, wrapped with
     | Ok s, _ -> s
     | Warn _, true -> Errors.fail loc "%s" wrapped_message
-    | Warn s, false -> Dloc.warn loc "%s" wrapped_message; s
+    | Warn s, false -> Errors.warn loc "%s" wrapped_message; s
     | Invalid, _ -> Errors.fail loc "%s" invalid_message
 
   let valid_char = function
@@ -1289,7 +1289,7 @@ module Executables = struct
           | Some (loc, _) ->
             let func =
               match file_kind with
-              | Jbuild -> Dloc.warn
+              | Jbuild -> Errors.warn
               | Dune   -> Errors.fail
             in
             func loc

src/errors.ml

@@ -33,3 +33,66 @@ let fail_opt t fmt =
   match t with
   | None -> die fmt
   | Some t -> fail t fmt
+
+let file_line path n =
+  Io.with_file_in ~binary:false path
+    ~f:(fun ic ->
+      for _ = 1 to n - 1 do
+        ignore (input_line ic)
+      done;
+      input_line ic
+    )
+
+let file_lines path ~start ~stop =
+  Io.with_file_in ~binary:true path
+    ~f:(fun ic ->
+      let rec aux acc lnum =
+        if lnum > stop then
+          List.rev acc
+        else if lnum < start then
+          (ignore (input_line ic);
+           aux acc (lnum + 1))
+        else
+          let line = input_line ic in
+          aux ((string_of_int lnum, line) :: acc) (lnum + 1)
+      in
+      aux [] 1
+    )
+
+let print ppf loc =
+  let { Loc.start; stop } = loc in
+  let start_c = start.pos_cnum - start.pos_bol in
+  let stop_c  = stop.pos_cnum  - start.pos_bol in
+  let num_lines = stop.pos_lnum - start.pos_lnum in
+  let pp_file_excerpt pp () =
+    let whole_file = start_c = 0 && stop_c = 0 in
+    if not whole_file then
+      let path = Path.of_string start.pos_fname in
+      if Path.exists path then
+        let line = file_line path start.pos_lnum in
+        if stop_c <= String.length line then
+          let len = stop_c - start_c in
+          Format.fprintf pp "%s\n%*s\n" line
+            stop_c
+            (String.make len '^')
+        else if num_lines <= 10 then
+          let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
+          let last_lnum = Option.map ~f:fst (List.last lines) in
+          let padding_width = Option.value_exn
+                                (Option.map ~f:String.length last_lnum) in
+          List.iter ~f:(fun (lnum, l) ->
+            Format.fprintf pp "%*s: %s\n" padding_width lnum l)
+          lines
+  in
+  Format.fprintf ppf
+    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
+    start.pos_fname start.pos_lnum start_c stop_c
+    pp_file_excerpt ()
+
+(* This is ugly *)
+let printer = ref (Printf.eprintf "%s%!")
+let print_to_console s = !printer s
+
+let warn t fmt =
+  kerrf ~f:print_to_console
+    ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t

src/errors.mli

@@ -27,3 +27,13 @@ val exnf     : Loc.t         -> ('a, Format.formatter, unit, exn) format4 -> 'a
 val fail     : Loc.t         -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
 val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
 val fail_opt : Loc.t option  -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
+
+(** Prints "File ..., line ..., characters ...:\n" *)
+val print : Format.formatter -> Loc.t -> unit
+
+(** Prints a warning *)
+val warn : Loc.t -> ('a, Format.formatter, unit) format -> 'a
+
+val print_to_console : string -> unit
+
+val printer : (string -> unit) ref

src/file_tree.ml

@@ -89,12 +89,12 @@ let load_jbuild_ignore path =
     if Filename.dirname fn = Filename.current_dir_name then
       true
     else begin
-      Dloc.(warn (Loc.of_pos
+      Errors.(warn (Loc.of_pos
-                    ( Path.to_string path
+                      ( Path.to_string path
-                    , i + 1, 0
+                      , i + 1, 0
-                    , String.length fn
+                      , String.length fn
-                    ))
+                      ))
-              "subdirectory expression %s ignored" fn);
+                "subdirectory expression %s ignored" fn);
       false
     end)
   |> String.Set.of_list

src/import.ml

@@ -89,6 +89,4 @@ module No_io = struct
   module Io = struct end
 end
 
-(* This is ugly *)
+let print_to_console = Errors.print_to_console
-let printer = ref (Printf.eprintf "%s%!")
-let print_to_console s = !printer s

src/lib.ml

@@ -1138,7 +1138,7 @@ let report_lib_error ppf (e : Error.t) =
   | No_solution_found_for_select { loc } ->
     Format.fprintf ppf
       "%a@{<error>Error@}: No solution found for this select form.\n"
-      Dloc.print loc
+      Errors.print loc
   | Dependency_cycle cycle ->
     Format.fprintf ppf
       "@{<error>Error@}: Dependency cycle detected between the \

src/print_diff.ml

@@ -16,7 +16,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
   in
   let loc = Loc.in_file file1 in
   let fallback () =
-    die "%aFiles %s and %s differ." Dloc.print loc
+    die "%aFiles %s and %s differ." Errors.print loc
       (Path.to_string_maybe_quoted path1)
       (Path.to_string_maybe_quoted path2)
   in
@@ -24,7 +24,7 @@ let print ?(skip_trailing_cr=Sys.win32) path1 path2 =
     match Bin.which "diff" with
     | None -> fallback ()
     | Some prog ->
-      Format.eprintf "%a@?" Dloc.print loc;
+      Format.eprintf "%a@?" Errors.print loc;
       Process.run ~dir ~env:Env.initial Strict prog
         (List.concat
            [ ["-u"]

src/report_error.ml

@@ -121,7 +121,7 @@ let report exn =
       else
         p.loc
     in
-    Option.iter loc ~f:(fun loc -> Dloc.print ppf loc);
+    Option.iter loc ~f:(fun loc -> Errors.print ppf loc);
     p.pp ppf;
     Format.pp_print_flush ppf ();
     let s = Buffer.contents err_buf in

src/scheduler.ml

@@ -196,7 +196,7 @@ let go ?(log=Log.no_log) ?(config=Config.default)
     ; waiting_for_available_job = Queue.create ()
     }
   in
-  printer := print t;
+  Errors.printer := print t;
   let fiber =
     Fiber.Var.set t_var t
       (Fiber.with_error_handler (fun () -> fiber) ~on_error:Report_error.report)

src/stanza.ml

@@ -88,7 +88,7 @@ module Of_sexp = struct
     match Univ_map.find parsing_context (Syntax.key syntax) with
     | Some (0, _) ->
       let last = Option.value_exn (List.last entries) in
-      Dloc.warn (Dsexp.Ast.loc last)
+      Errors.warn (Dsexp.Ast.loc last)
         "Field %S is present several times, previous occurrences are ignored."
         name
     | _ ->

src/super_context.ml

@@ -856,7 +856,7 @@ module Action = struct
               assert false
             | Unnamed v :: _ -> [Path v]
             | [] ->
-              Dloc.warn loc "Variable '%s' used with no explicit \
+              Errors.warn loc "Variable '%s' used with no explicit \
                             dependencies@." key;
               [Value.String ""]
             end
@@ -874,7 +874,7 @@ module Action = struct
       | [] -> ()
       | x :: _ ->
         let loc = String_with_vars.loc x in
-        Dloc.warn loc
+        Errors.warn loc
           "Aliases must not have targets, this target will be ignored.\n\
            This will become an error in the future.";
     end;