From 0d76abca91a2e24e4210889990344f598a24cbd8 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 24 Apr 2018 23:17:53 +0700 Subject: [PATCH 01/12] Move ocaml-syntax related stuff to jbuild_load This stuff is too specific to parsing jbuild files to be in stdune --- src/jbuild_load.ml | 41 ++++++++++++++++++++++++++++++++++++++++- src/stdune/sexp.ml | 35 ----------------------------------- src/stdune/sexp.mli | 10 ++++------ 3 files changed, 44 insertions(+), 42 deletions(-) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 67dd1070..6e33c073 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -171,9 +171,48 @@ type conf = ; scopes : Scope_info.t list } +module Sexp_io = struct + open Sexp + + let ocaml_script_prefix = "(* -*- tuareg -*- *)" + let ocaml_script_prefix_len = String.length ocaml_script_prefix + + type sexps_or_ocaml_script = + | Sexps of Ast.t list + | Ocaml_script + + let load_many_or_ocaml_script fname = + Io.with_file_in fname ~f:(fun ic -> + let state = Parser.create ~fname ~mode:Many in + let buf = Bytes.create buf_len in + let rec loop stack = + match input ic buf 0 buf_len with + | 0 -> Parser.feed_eoi state stack + | n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack) + in + let rec loop0 stack i = + match input ic buf i (buf_len - i) with + | 0 -> + let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in + Sexps (Parser.feed_eoi state stack) + | n -> + let i = i + n in + if i < ocaml_script_prefix_len then + loop0 stack i + else if Bytes.sub_string buf 0 ocaml_script_prefix_len + [@warning "-6"] + = ocaml_script_prefix then + Ocaml_script + else + let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in + Sexps (loop stack) + in + loop0 Parser.Stack.empty 0) +end + let load ~dir ~scope ~ignore_promoted_rules = let file = Path.relative dir "jbuild" in - match Sexp.load_many_or_ocaml_script (Path.to_string file) with + match Sexp_io.load_many_or_ocaml_script (Path.to_string file) with | Sexps sexps -> Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps ~file diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index f30bbe52..7ace78e5 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -21,41 +21,6 @@ let load_many_as_one ~fname = let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in Ast.List (loc, x :: l) -let ocaml_script_prefix = "(* -*- tuareg -*- *)" -let ocaml_script_prefix_len = String.length ocaml_script_prefix - -type sexps_or_ocaml_script = - | Sexps of Ast.t list - | Ocaml_script - -let load_many_or_ocaml_script fname = - Io.with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode:Many in - let buf = Bytes.create buf_len in - let rec loop stack = - match input ic buf 0 buf_len with - | 0 -> Parser.feed_eoi state stack - | n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack) - in - let rec loop0 stack i = - match input ic buf i (buf_len - i) with - | 0 -> - let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in - Sexps (Parser.feed_eoi state stack) - | n -> - let i = i + n in - if i < ocaml_script_prefix_len then - loop0 stack i - else if Bytes.sub_string buf 0 ocaml_script_prefix_len - [@warning "-6"] - = ocaml_script_prefix then - Ocaml_script - else - let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in - Sexps (loop stack) - in - loop0 Parser.Stack.empty 0) - module type Combinators = sig type 'a t val unit : unit t diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index b4cb16fb..d1a2d49c 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -3,12 +3,6 @@ include module type of struct include Usexp end with module Loc := Usexp.Loc val load : fname:string -> mode:'a Parser.Mode.t -> 'a val load_many_as_one : fname:string -> Ast.t -type sexps_or_ocaml_script = - | Sexps of Ast.t list - | Ocaml_script - -val load_many_or_ocaml_script : string -> sexps_or_ocaml_script - module type Combinators = sig type 'a t val unit : unit t @@ -161,3 +155,7 @@ module Of_sexp : sig val enum : (string * 'a) list -> 'a t end + +(**/**) +(* used in jbuild_load *) +val buf_len : int From 79e434c6581a5d2ca745b8ff2cb421b7352b0d0d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 24 Apr 2018 23:21:42 +0700 Subject: [PATCH 02/12] Move sexp's io functions to Io.Sexp to avoid circular dependencies when adding Path.t to Io --- src/action.ml | 2 +- src/build_system.ml | 6 +++--- src/config.ml | 2 +- src/installed_dune_file.ml | 2 +- src/jbuild.ml | 2 +- src/jbuild_load.ml | 8 ++++---- src/stdune/io.ml | 25 +++++++++++++++++++++++++ src/stdune/io.mli | 9 +++++++++ src/stdune/sexp.ml | 21 --------------------- src/stdune/sexp.mli | 7 ------- src/utils.ml | 2 +- src/vfile_kind.ml | 2 +- src/workspace.ml | 2 +- 13 files changed, 48 insertions(+), 42 deletions(-) diff --git a/src/action.ml b/src/action.ml index 85ac8f53..6dc2f76f 100644 --- a/src/action.ml +++ b/src/action.ml @@ -660,7 +660,7 @@ module Promotion = struct let load_db () = if Sys.file_exists db_file then - Sexp.load ~fname:db_file ~mode:Many + Io.Sexp.load ~fname:db_file ~mode:Many |> List.map ~f:File.t else [] diff --git a/src/build_system.ml b/src/build_system.ml index 6f9e39c5..57000e14 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -20,7 +20,7 @@ module Promoted_to_delete = struct let load () = if Sys.file_exists fn then - Sexp.load ~fname:fn ~mode:Many + Io.Sexp.load ~fname:fn ~mode:Many |> List.map ~f:Path.t else [] @@ -1126,7 +1126,7 @@ module Trace = struct let load () = let trace = Hashtbl.create 1024 in if Sys.file_exists file then begin - let sexp = Sexp.load ~fname:file ~mode:Single in + let sexp = Io.Sexp.load ~fname:file ~mode:Single in let bindings = let open Sexp.Of_sexp in list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp @@ -1207,7 +1207,7 @@ let update_universe t = let fname = Path.to_string universe_file in let n = if Sys.file_exists fname then - Sexp.Of_sexp.int (Sexp.load ~mode:Single ~fname) + 1 + Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single ~fname) + 1 else 0 in diff --git a/src/config.ml b/src/config.ml index f877248e..9e5dc406 100644 --- a/src/config.ml +++ b/src/config.ml @@ -81,7 +81,7 @@ let t = let user_config_file = Filename.concat Xdg.config_dir "dune/config" let load_config_file ~fname = - t (Sexp.load_many_as_one ~fname) + t (Io.Sexp.load_many_as_one ~fname) let load_user_config_file () = if Sys.file_exists user_config_file then diff --git a/src/installed_dune_file.ml b/src/installed_dune_file.ml index 04480905..8dde3ae8 100644 --- a/src/installed_dune_file.ml +++ b/src/installed_dune_file.ml @@ -39,7 +39,7 @@ let of_sexp = (fun () l -> parse_sub_systems l) ] -let load ~fname = of_sexp (Sexp.load ~mode:Single ~fname) +let load ~fname = of_sexp (Io.Sexp.load ~mode:Single ~fname) let gen confs = let sexps = diff --git a/src/jbuild.ml b/src/jbuild.ml index d196bef7..f41befb1 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1244,7 +1244,7 @@ module Stanzas = struct (Path.to_string_maybe_quoted file); if List.exists include_stack ~f:(fun (_, f) -> f = file) then raise (Include_loop (file, include_stack)); - let sexps = Sexp.load ~fname:(Path.to_string file) ~mode:Many in + let sexps = Io.Sexp.load ~fname:(Path.to_string file) ~mode:Many in parse pkgs sexps ~default_version:Jbuild_version.V1 ~file ~include_stack) ; cstr "documentation" (Documentation.v1 pkgs @> nil) (fun d -> [Documentation d]) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 6e33c073..018f776f 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -157,7 +157,7 @@ end die "@{Error:@} %s failed to produce a valid jbuild file.\n\ Did you forgot to call [Jbuild_plugin.V*.send]?" (Path.to_string file); - let sexps = Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in + let sexps = Io.Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in Fiber.return (dir, scope, Stanzas.parse scope sexps ~file:generated_jbuild |> filter_stanzas ~ignore_promoted_rules)) >>| fun dynamic -> @@ -184,14 +184,14 @@ module Sexp_io = struct let load_many_or_ocaml_script fname = Io.with_file_in fname ~f:(fun ic -> let state = Parser.create ~fname ~mode:Many in - let buf = Bytes.create buf_len in + let buf = Bytes.create Io.buf_len in let rec loop stack = - match input ic buf 0 buf_len with + match input ic buf 0 Io.buf_len with | 0 -> Parser.feed_eoi state stack | n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack) in let rec loop0 stack i = - match input ic buf i (buf_len - i) with + match input ic buf i (Io.buf_len - i) with | 0 -> let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in Sexps (Parser.feed_eoi state stack) diff --git a/src/stdune/io.ml b/src/stdune/io.ml index fc39d707..74ba8cb9 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -76,3 +76,28 @@ let copy_file ~src ~dst = (* TODO: diml: improve this *) let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2) + +let buf_len = 65_536 + +module Sexp = struct + open Sexp + + let load ~fname ~mode = + with_file_in fname ~f:(fun ic -> + let state = Parser.create ~fname ~mode in + let buf = Bytes.create buf_len in + let rec loop stack = + match input ic buf 0 buf_len with + | 0 -> Parser.feed_eoi state stack + | n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack) + in + loop Parser.Stack.empty) + + let load_many_as_one ~fname = + match load ~fname ~mode:Many with + | [] -> Ast.List (Loc.in_file fname, []) + | x :: l -> + let last = Option.value (List.last l) ~default:x in + let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in + Ast.List (loc, x :: l) +end diff --git a/src/stdune/io.mli b/src/stdune/io.mli index 9b621f36..cc1a604a 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -25,3 +25,12 @@ val copy_channels : in_channel -> out_channel -> unit val copy_file : src:string -> dst:string -> unit val read_all : in_channel -> string + +module Sexp : sig + val load : fname:string -> mode:'a Sexp.Parser.Mode.t -> 'a + val load_many_as_one : fname:string -> Sexp.Ast.t +end + +(**/**) +(* used in jbuild_load *) +val buf_len : int diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index 7ace78e5..9e6272d9 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -1,26 +1,5 @@ include Usexp -let buf_len = 65_536 - -let load ~fname ~mode = - Io.with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode in - let buf = Bytes.create buf_len in - let rec loop stack = - match input ic buf 0 buf_len with - | 0 -> Parser.feed_eoi state stack - | n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack) - in - loop Parser.Stack.empty) - -let load_many_as_one ~fname = - match load ~fname ~mode:Many with - | [] -> Ast.List (Loc.in_file fname, []) - | x :: l -> - let last = Option.value (List.last l) ~default:x in - let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in - Ast.List (loc, x :: l) - module type Combinators = sig type 'a t val unit : unit t diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index d1a2d49c..f289664b 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -1,8 +1,5 @@ include module type of struct include Usexp end with module Loc := Usexp.Loc -val load : fname:string -> mode:'a Parser.Mode.t -> 'a -val load_many_as_one : fname:string -> Ast.t - module type Combinators = sig type 'a t val unit : unit t @@ -155,7 +152,3 @@ module Of_sexp : sig val enum : (string * 'a) list -> 'a t end - -(**/**) -(* used in jbuild_load *) -val buf_len : int diff --git a/src/utils.ml b/src/utils.ml index 8189cb65..257a27f9 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -204,7 +204,7 @@ module Cached_digest = struct let load () = if Sys.file_exists db_file then begin - let sexp = Sexp.load ~fname:db_file ~mode:Single in + let sexp = Io.Sexp.load ~fname:db_file ~mode:Single in let bindings = let open Sexp.Of_sexp in list diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index 3bc42f10..0c88e584 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -55,7 +55,7 @@ struct let to_string path x = To_sexp.t path x |> Sexp.to_string let load path = - Of_sexp.t path (Sexp.load ~fname:(Path.to_string path) ~mode:Single) + Of_sexp.t path (Io.Sexp.load ~fname:(Path.to_string path) ~mode:Single) end diff --git a/src/workspace.ml b/src/workspace.ml index 70448a68..338ea240 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -135,4 +135,4 @@ let t ?x sexps = ; contexts = List.rev contexts } -let load ?x fname = t ?x (Sexp.load ~fname ~mode:Many) +let load ?x fname = t ?x (Io.Sexp.load ~fname ~mode:Many) From 7820e29d288a839f8f816f1d3d2b8499efb3d633 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 03:25:27 +0700 Subject: [PATCH 03/12] Port Io to use Path.t --- bin/main.ml | 11 ++++++----- src/action.ml | 37 ++++++++++++++++-------------------- src/build_system.ml | 27 ++++++++++++-------------- src/config.ml | 11 ++++++----- src/config.mli | 4 ++-- src/configurator/v1.ml | 15 ++++++++------- src/file_tree.ml | 5 +++-- src/findlib.ml | 6 +++--- src/installed_dune_file.ml | 2 +- src/installed_dune_file.mli | 2 +- src/jbuild.ml | 2 +- src/jbuild_load.ml | 19 +++++++++--------- src/lib.ml | 3 +-- src/log.ml | 2 +- src/main.ml | 4 ++-- src/main.mli | 2 +- src/meta.ml | 4 ++-- src/meta.mli | 2 +- src/opam_file.ml | 2 +- src/opam_file.mli | 4 +++- src/process.ml | 9 ++++++--- src/stdune/io.ml | 26 +++++++++++++------------ src/stdune/io.mli | 26 ++++++++++++------------- src/stdune/path.ml | 3 +++ src/stdune/path.mli | 1 + src/utils.ml | 6 +++--- src/vfile_kind.ml | 2 +- src/watermarks.ml | 19 +++++++++--------- src/workspace.ml | 2 +- src/workspace.mli | 2 +- test/blackbox-tests/cram.mll | 4 +++- test/unit-tests/tests.mlt | 3 ++- 32 files changed, 138 insertions(+), 129 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index eddd8876..6323efef 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -75,7 +75,7 @@ module Main = struct let setup ~log ?external_lib_deps_mode common = setup ~log - ?workspace_file:common.workspace_file + ?workspace_file:(Option.map ~f:Path.of_string common.workspace_file) ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x @@ -182,7 +182,7 @@ let help_secs = type config_file = | No_config | Default - | This of string + | This of Path.t let incompatible a b = `Error (true, @@ -234,7 +234,7 @@ let common = let config = match config_file with | No_config -> Config.default - | This fname -> Config.load_config_file ~fname + | This fname -> Config.load_config_file fname | Default -> if Config.inside_dune then Config.default @@ -410,7 +410,7 @@ let common = let merge config_file no_config = match config_file, no_config with | None , false -> `Ok (None , Default) - | Some fn, false -> `Ok (Some "--config-file", This fn) + | Some fn, false -> `Ok (Some "--config-file", This (Path.of_string fn)) | None , true -> `Ok (Some "--no-config" , No_config) | Some _ , true -> incompatible "--no-config" "--config-file" in @@ -455,7 +455,7 @@ let common = else [] ; (match config_file with - | This fn -> ["--config-file"; fn] + | This fn -> ["--config-file"; Path.to_string fn] | No_config -> ["--no-config"] | Default -> []) ] @@ -859,6 +859,7 @@ let rules = ] in let go common out recursive makefile_syntax targets = + let out = Option.map ~f:Path.of_string out in set_common common ~targets; let log = Log.create common in Scheduler.go ~log ~common diff --git a/src/action.ml b/src/action.ml index 6dc2f76f..143a428b 100644 --- a/src/action.ml +++ b/src/action.ml @@ -641,17 +641,15 @@ module Promotion = struct Format.eprintf "Promoting %s to %s.@." (Path.to_string_maybe_quoted src) (Path.to_string_maybe_quoted dst); - Io.copy_file - ~src:(Path.to_string src) - ~dst:(Path.to_string dst) + Io.copy_file ~src ~dst end - let db_file = "_build/.to-promote" + let db_file = Path.of_string "_build/.to-promote" let dump_db db = if Sys.file_exists "_build" then begin match db with - | [] -> if Sys.file_exists db_file then Sys.remove db_file + | [] -> if Path.is_file db_file then Path.unlink_no_err db_file | l -> Io.write_file db_file (String.concat ~sep:"" @@ -659,8 +657,8 @@ module Promotion = struct end let load_db () = - if Sys.file_exists db_file then - Io.Sexp.load ~fname:db_file ~mode:Many + if Path.is_file db_file then + Io.Sexp.load db_file ~mode:Many |> List.map ~f:File.t else [] @@ -765,7 +763,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec t ~ectx ~dir ~stdout_to ~stderr_to ~env:(Env.add env ~var ~value) | Redirect (Stdout, fn, Echo s) -> - Io.write_file (Path.to_string fn) s; + Io.write_file fn s; Fiber.return () | Redirect (outputs, fn, Run (Ok prog, args)) -> let out = Process.File (Path.to_string fn) in @@ -784,7 +782,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to | Echo str -> exec_echo stdout_to str | Cat fn -> - Io.with_file_in (Path.to_string fn) ~f:(fun ic -> + Io.with_file_in fn ~f:(fun ic -> let oc = match stdout_to with | None -> stdout @@ -793,11 +791,11 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Io.copy_channels ic oc); Fiber.return () | Copy (src, dst) -> - Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst); + Io.copy_file ~src ~dst; Fiber.return () | Symlink (src, dst) -> if Sys.win32 then - Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst) + Io.copy_file ~src ~dst else begin let src = if Path.is_root dst then @@ -818,8 +816,8 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = end; Fiber.return () | Copy_and_add_line_directive (src, dst) -> - Io.with_file_in (Path.to_string src) ~f:(fun ic -> - Io.with_file_out (Path.to_string dst) ~f:(fun oc -> + Io.with_file_in src ~f:(fun ic -> + Io.with_file_out dst ~f:(fun oc -> let fn = Path.drop_optional_build_context src in let directive = if List.mem (Path.extension fn) ~set:[".c"; ".cpp"; ".h"] then @@ -840,7 +838,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = (Utils.bash_exn ~needed_to:"interpret (bash ...) actions") ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] | Write_file (fn, s) -> - Io.write_file (Path.to_string fn) s; + Io.write_file fn s; Fiber.return () | Rename (src, dst) -> Unix.rename (Path.to_string src) (Path.to_string dst); @@ -870,7 +868,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec_echo stdout_to s | Diff { optional; file1; file2 } -> if (optional && not (Path.exists file1 && Path.exists file2)) || - Io.compare_files (Path.to_string file1) (Path.to_string file2) = Eq then + Io.compare_files file1 file2 = Eq then Fiber.return () else begin let is_copied_from_source_tree file = @@ -892,21 +890,18 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = List.fold_left ~init:(String.Set.of_list extras) ~f:(fun set source_path -> - Path.to_string source_path - |> Io.lines_of_file + Io.lines_of_file source_path |> String.Set.of_list |> String.Set.union set ) sources in - Io.write_lines - (Path.to_string target) - (String.Set.to_list lines); + Io.write_lines target (String.Set.to_list lines); Fiber.return () and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = - let fn = Path.to_string fn in let oc = Io.open_out fn in + let fn = Path.to_string fn in let out = Some (fn, oc) in let stdout_to, stderr_to = match outputs with diff --git a/src/build_system.ml b/src/build_system.ml index 57000e14..dfb9205f 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -14,13 +14,13 @@ let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct let db = ref [] - let fn = "_build/.to-delete-in-source-tree" + let fn = Path.of_string "_build/.to-delete-in-source-tree" let add p = db := p :: !db let load () = - if Sys.file_exists fn then - Io.Sexp.load ~fname:fn ~mode:Many + if Path.is_file fn then + Io.Sexp.load fn ~mode:Many |> List.map ~f:Path.t else [] @@ -460,8 +460,8 @@ module Build_exec = struct | Paths _ -> x | Paths_for_rule _ -> x | Paths_glob state -> get_glob_result_exn state - | Contents p -> Io.read_file (Path.to_string p) - | Lines_of p -> Io.lines_of_file (Path.to_string p) + | Contents p -> Io.read_file p + | Lines_of p -> Io.lines_of_file p | Vpath (Vspec.T (fn, kind)) -> let file : b File_spec.t = get_file bs fn (Sexp_file kind) in Option.value_exn file.data @@ -766,9 +766,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = let in_source_tree = Option.value_exn (Path.drop_build_context path) in if mode = Promote_but_delete_on_clean then Promoted_to_delete.add in_source_tree; - Io.copy_file - ~src:(Path.to_string path) - ~dst:(Path.to_string in_source_tree))); + Io.copy_file ~src:path ~dst:in_source_tree)); t.hook Rule_completed end else begin t.hook Rule_completed; @@ -1108,7 +1106,7 @@ let stamp_file_for_files_of t ~dir ~ext = module Trace = struct type t = (Path.t, Digest.t) Hashtbl.t - let file = "_build/.db" + let file = Path.of_string "_build/.db" let dump (trace : t) = let sexp = @@ -1125,8 +1123,8 @@ module Trace = struct let load () = let trace = Hashtbl.create 1024 in - if Sys.file_exists file then begin - let sexp = Io.Sexp.load ~fname:file ~mode:Single in + if Path.is_file file then begin + let sexp = Io.Sexp.load file ~mode:Single in let bindings = let open Sexp.Of_sexp in list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp @@ -1204,15 +1202,14 @@ let universe_file = Path.relative Path.build_dir ".universe-state" let update_universe t = (* To workaround the fact that [mtime] is not precise enough on OSX *) Utils.Cached_digest.remove universe_file; - let fname = Path.to_string universe_file in let n = - if Sys.file_exists fname then - Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single ~fname) + 1 + if Path.is_file universe_file then + Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single universe_file) + 1 else 0 in make_local_dirs t (Pset.singleton Path.build_dir); - Io.write_file fname (Sexp.to_string (Sexp.To_sexp.int n)) + Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n)) let do_build t ~request = entry_point t ~f:(fun () -> diff --git a/src/config.ml b/src/config.ml index 9e5dc406..b996c5ac 100644 --- a/src/config.ml +++ b/src/config.ml @@ -78,14 +78,15 @@ let t = ; concurrency }) -let user_config_file = Filename.concat Xdg.config_dir "dune/config" +let user_config_file = + Path.relative (Path.of_string Xdg.config_dir) "dune/config" -let load_config_file ~fname = - t (Io.Sexp.load_many_as_one ~fname) +let load_config_file p = + t (Io.Sexp.load_many_as_one p) let load_user_config_file () = - if Sys.file_exists user_config_file then - load_config_file ~fname:user_config_file + if Path.is_file user_config_file then + load_config_file user_config_file else default diff --git a/src/config.mli b/src/config.mli index 2f50db62..ee7787e9 100644 --- a/src/config.mli +++ b/src/config.mli @@ -52,9 +52,9 @@ val t : t Sexp.Of_sexp.t val merge : t -> Partial.t -> t val default : t -val user_config_file : string +val user_config_file : Path.t val load_user_config_file : unit -> t -val load_config_file : fname:string -> t +val load_config_file : Path.t -> t (** Set display mode to [Quiet] if it is [Progress], the output is not a tty and we are not running inside emacs. *) diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index f0b68e56..d96e27ec 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -144,8 +144,8 @@ let run t ~dir cmd = (Filename.quote stdout_fn) (Filename.quote stderr_fn) in - let stdout = Io.read_file stdout_fn in - let stderr = Io.read_file 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 logf t "-> process exited with code %d" exit_code; logf t "-> stdout:"; List.iter (String.split_lines stdout) ~f:(logf t " | %s"); @@ -239,7 +239,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 c_fname code; + Io.write_file (Path.of_string c_fname) code; logf t "compiling c program:"; List.iter (String.split_lines code) ~f:(logf t " | %s"); let run_ok args = @@ -269,7 +269,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 c_fname code; + Io.write_file (Path.of_string c_fname) code; logf t "compiling c program:"; List.iter (String.split_lines code) ~f:(logf t " | %s"); let run_ok args = @@ -286,7 +286,7 @@ let compile_c_prog t ?(c_flags=[]) code = ] ]) in - if ok then Ok obj_fname else Error () + if ok then Ok (Path.of_string 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 @@ -415,7 +415,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 tmp_fname lines; + Io.write_lines (Path.of_string tmp_fname) lines; Sys.rename tmp_fname fname end @@ -481,8 +481,9 @@ module Pkg_config = struct end let write_flags fname s = + let path = Path.of_string fname in let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in - Io.write_file fname (Usexp.to_string sexp) + Io.write_file path (Usexp.to_string sexp) let main ?(args=[]) ~name f = let ocamlc = ref ( diff --git a/src/file_tree.ml b/src/file_tree.ml index 20272254..1364eefd 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -62,7 +62,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = let files = String.Set.of_list files in let ignored_sub_dirs = if not ignored && String.Set.mem files "jbuild-ignore" then - let ignore_file = Path.to_string (Path.relative path "jbuild-ignore") in + let ignore_file = Path.relative path "jbuild-ignore" in let files = Io.lines_of_file ignore_file in @@ -70,7 +70,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = if Filename.dirname fn = Filename.current_dir_name then true else begin - Loc.(warn (of_pos (ignore_file, index + 1, 0, String.length fn)) + Loc.(warn (of_pos ( Path.to_string ignore_file + , index + 1, 0, String.length fn)) "subdirectory expression %s ignored" fn); false end diff --git a/src/findlib.ml b/src/findlib.ml index 107a7cc0..e534ed3b 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -99,7 +99,7 @@ module Config = struct if not (Path.exists conf_file) then die "@{Error@}: ocamlfind toolchain %s isn't defined in %a \ (context: %s)" toolchain Path.pp path context; - let vars = (Meta.load ~name:"" ~fn:(Path.to_string conf_file)).vars in + let vars = (Meta.load ~name:"" conf_file).vars in { vars = String.Map.map vars ~f:Rules.of_meta_rules ; preds = Ps.make [toolchain] } @@ -266,14 +266,14 @@ let find_and_acknowledge_meta t ~fq_name = if Path.exists fn then Some (sub_dir, fn, - Meta.load ~name:root_name ~fn:(Path.to_string fn)) + Meta.load ~name:root_name fn) else (* Alternative layout *) let fn = Path.relative dir ("META." ^ root_name) in if Path.exists fn then Some (dir, fn, - Meta.load ~fn:(Path.to_string fn) ~name:root_name) + Meta.load fn ~name:root_name) else loop dirs | [] -> diff --git a/src/installed_dune_file.ml b/src/installed_dune_file.ml index 8dde3ae8..c2a9b4e3 100644 --- a/src/installed_dune_file.ml +++ b/src/installed_dune_file.ml @@ -39,7 +39,7 @@ let of_sexp = (fun () l -> parse_sub_systems l) ] -let load ~fname = of_sexp (Io.Sexp.load ~mode:Single ~fname) +let load fname = of_sexp (Io.Sexp.load ~mode:Single fname) let gen confs = let sexps = diff --git a/src/installed_dune_file.mli b/src/installed_dune_file.mli index 18425920..d498cb00 100644 --- a/src/installed_dune_file.mli +++ b/src/installed_dune_file.mli @@ -2,5 +2,5 @@ open Stdune -val load : fname:string -> Jbuild.Sub_system_info.t Sub_system_name.Map.t +val load : Path.t -> Jbuild.Sub_system_info.t Sub_system_name.Map.t val gen : (Syntax.Version.t * Sexp.t) Sub_system_name.Map.t -> Sexp.t diff --git a/src/jbuild.ml b/src/jbuild.ml index f41befb1..e599b34e 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1244,7 +1244,7 @@ module Stanzas = struct (Path.to_string_maybe_quoted file); if List.exists include_stack ~f:(fun (_, f) -> f = file) then raise (Include_loop (file, include_stack)); - let sexps = Io.Sexp.load ~fname:(Path.to_string file) ~mode:Many in + let sexps = Io.Sexp.load file ~mode:Many in parse pkgs sexps ~default_version:Jbuild_version.V1 ~file ~include_stack) ; cstr "documentation" (Documentation.v1 pkgs @> nil) (fun d -> [Documentation d]) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 018f776f..aee09def 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -33,7 +33,7 @@ module Jbuilds = struct type requires = No_requires | Unix - let extract_requires ~fname str = + let extract_requires path str = let rec loop n lines acc = match lines with | [] -> acc @@ -48,7 +48,7 @@ module Jbuilds = struct | _ -> let start = { Lexing. - pos_fname = fname + pos_fname = Path.to_string path ; pos_lnum = n ; pos_cnum = 0 ; pos_bol = 0 @@ -64,9 +64,8 @@ module Jbuilds = struct loop 1 (String.split str ~on:'\n') No_requires let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target = - let plugin = Path.to_string plugin in let plugin_contents = Io.read_file plugin in - Io.with_file_out (Path.to_string wrapper) ~f:(fun oc -> + Io.with_file_out wrapper ~f:(fun oc -> let ocamlc_config = let vars = Ocaml_config.to_list context.ocaml_config @@ -105,8 +104,8 @@ end context.version_string ocamlc_config (Path.reach ~from:exec_dir target) - plugin plugin_contents); - extract_requires ~fname:plugin plugin_contents + (Path.to_string plugin) plugin_contents); + extract_requires plugin plugin_contents let eval { jbuilds; ignore_promoted_rules } ~(context : Context.t) = let open Fiber.O in @@ -157,7 +156,7 @@ end die "@{Error:@} %s failed to produce a valid jbuild file.\n\ Did you forgot to call [Jbuild_plugin.V*.send]?" (Path.to_string file); - let sexps = Io.Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in + let sexps = Io.Sexp.load generated_jbuild ~mode:Many in Fiber.return (dir, scope, Stanzas.parse scope sexps ~file:generated_jbuild |> filter_stanzas ~ignore_promoted_rules)) >>| fun dynamic -> @@ -183,7 +182,7 @@ module Sexp_io = struct let load_many_or_ocaml_script fname = Io.with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode:Many in + let state = Parser.create ~fname:(Path.to_string fname) ~mode:Many in let buf = Bytes.create Io.buf_len in let rec loop stack = match input ic buf 0 Io.buf_len with @@ -212,7 +211,7 @@ end let load ~dir ~scope ~ignore_promoted_rules = let file = Path.relative dir "jbuild" in - match Sexp_io.load_many_or_ocaml_script (Path.to_string file) with + match Sexp_io.load_many_or_ocaml_script file with | Sexps sexps -> Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps ~file @@ -230,7 +229,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = match Filename.split_extension fn with | (pkg, ".opam") when pkg <> "" -> let version_from_opam_file = - let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in + let opam = Opam_file.load (Path.relative path fn) in match Opam_file.get_field opam "version" with | Some (String (_, s)) -> Some s | _ -> None diff --git a/src/lib.ml b/src/lib.ml index 7c0bc0aa..a3967af1 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -123,8 +123,7 @@ module Info = struct let sub_systems = match P.dune_file pkg with | None -> Sub_system_name.Map.empty - | Some fn -> - Installed_dune_file.load ~fname:(Path.to_string fn) + | Some fn -> Installed_dune_file.load fn in { loc = loc ; kind = Normal diff --git a/src/log.ml b/src/log.ml index 3297b850..c78811d3 100644 --- a/src/log.ml +++ b/src/log.ml @@ -14,7 +14,7 @@ let no_log = None let create ?(display=Config.default.display) () = if not (Sys.file_exists "_build") then Unix.mkdir "_build" 0o777; - let oc = Io.open_out "_build/log" in + let oc = Io.open_out (Path.of_string "_build/log") in Printf.fprintf oc "# %s\n# OCAMLPARAM: %s\n%!" (String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ") (match Env.get Env.initial "OCAMLPARAM" with diff --git a/src/main.ml b/src/main.ml index 4edc096e..81a3004b 100644 --- a/src/main.ml +++ b/src/main.ml @@ -30,7 +30,7 @@ let setup_env ~capture_outputs = let setup ?(log=Log.no_log) ?external_lib_deps_mode - ?workspace ?(workspace_file="jbuild-workspace") + ?workspace ?(workspace_file=Path.of_string "jbuild-workspace") ?only_packages ?extra_ignored_subtrees ?x @@ -55,7 +55,7 @@ let setup ?(log=Log.no_log) match workspace with | Some w -> w | None -> - if Sys.file_exists workspace_file then + if Path.is_file workspace_file then Workspace.load ?x workspace_file else { merlin_context = Some "default" diff --git a/src/main.mli b/src/main.mli index a98a9c90..3c22f0b6 100644 --- a/src/main.mli +++ b/src/main.mli @@ -20,7 +20,7 @@ val setup : ?log:Log.t -> ?external_lib_deps_mode:bool -> ?workspace:Workspace.t - -> ?workspace_file:string + -> ?workspace_file:Path.t -> ?only_packages:Package.Name.Set.t -> ?x:string -> ?ignore_promoted_rules:bool diff --git a/src/meta.ml b/src/meta.ml index a216c6d8..b9f57635 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -170,10 +170,10 @@ let rec simplify t = in { pkg with vars = String.Map.add pkg.vars rule.var rules }) -let load ~fn ~name = +let load p ~name = { name ; entries = - Io.with_lexbuf_from_file fn ~f:(fun lb -> + Io.with_lexbuf_from_file p ~f:(fun lb -> Parse.entries lb 0 []) } |> simplify diff --git a/src/meta.mli b/src/meta.mli index 9d3c9d5a..8c38f9da 100644 --- a/src/meta.mli +++ b/src/meta.mli @@ -42,7 +42,7 @@ module Simplified : sig val pp : Format.formatter -> t -> unit end -val load : fn:string -> name:string -> Simplified.t +val load : Path.t -> name:string -> Simplified.t (** Builtin META files for libraries distributed with the compiler. For when ocamlfind is not installed. *) diff --git a/src/opam_file.ml b/src/opam_file.ml index db518188..e6022100 100644 --- a/src/opam_file.ml +++ b/src/opam_file.ml @@ -6,7 +6,7 @@ type t = opamfile let load fn = Io.with_lexbuf_from_file fn ~f:(fun lb -> try - OpamBaseParser.main OpamLexer.token lb fn + OpamBaseParser.main OpamLexer.token lb (Path.to_string fn) with | OpamLexer.Error msg -> Loc.fail_lex lb "%s" msg diff --git a/src/opam_file.mli b/src/opam_file.mli index ecb7a964..9878cc5a 100644 --- a/src/opam_file.mli +++ b/src/opam_file.mli @@ -1,12 +1,14 @@ (** Parsing and interpretation of opam files *) +open Stdune + open OpamParserTypes (** Type of opam files *) type t = opamfile (** Load a file *) -val load : string -> t +val load : Path.t -> t (** Extracts a field *) val get_field : t -> string -> value option diff --git a/src/process.ml b/src/process.ml index c1077f9e..bde8d5c8 100644 --- a/src/process.ml +++ b/src/process.ml @@ -255,7 +255,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose match output_filename with | None -> "" | Some fn -> - let s = Io.read_file fn in + let s = Io.read_file (Path.of_string fn) in Temp.destroy fn; let len = String.length s in if len > 0 && s.[len - 1] <> '\n' then @@ -329,11 +329,14 @@ let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f = Temp.destroy fn; x) -let run_capture = run_capture_gen ~f:Io.read_file -let run_capture_lines = run_capture_gen ~f:Io.lines_of_file +let run_capture = + run_capture_gen ~f:(fun p -> Io.read_file (Path.of_string p)) +let run_capture_lines = + run_capture_gen ~f:(fun p -> Io.lines_of_file (Path.of_string p)) let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = run_capture_gen ?dir ~env ~purpose fail_mode prog args ~f:(fun fn -> + let fn = Path.of_string fn in match Io.lines_of_file fn with | [x] -> x | l -> diff --git a/src/stdune/io.ml b/src/stdune/io.ml index 74ba8cb9..8a828ea0 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -1,9 +1,11 @@ module P = Pervasives -let open_in ?(binary=true) fn = +let open_in ?(binary=true) p = + let fn = Path.to_string p in if binary then P.open_in_bin fn else P.open_in fn -let open_out ?(binary=true) fn = +let open_out ?(binary=true) p = + let fn = Path.to_string p in if binary then P.open_out_bin fn else P.open_out fn let close_in = close_in @@ -12,14 +14,14 @@ let close_out = close_out let with_file_in ?binary fn ~f = Exn.protectx (open_in ?binary fn) ~finally:close_in ~f -let with_file_out ?binary fn ~f = - Exn.protectx (open_out ?binary fn) ~finally:close_out ~f +let with_file_out ?binary p ~f = + Exn.protectx (open_out ?binary p) ~finally:close_out ~f let with_lexbuf_from_file fn ~f = with_file_in fn ~f:(fun ic -> let lb = Lexing.from_channel ic in lb.lex_curr_p <- - { pos_fname = fn + { pos_fname = Path.to_string fn ; pos_lnum = 1 ; pos_bol = 0 ; pos_cnum = 0 @@ -69,7 +71,7 @@ let copy_file ~src ~dst = Exn.protectx (P.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] perm - dst) + (Path.to_string dst)) ~finally:close_out ~f:(fun oc -> copy_channels ic oc)) @@ -82,9 +84,9 @@ let buf_len = 65_536 module Sexp = struct open Sexp - let load ~fname ~mode = - with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode in + let load path ~mode = + with_file_in path ~f:(fun ic -> + let state = Parser.create ~fname:(Path.to_string path) ~mode in let buf = Bytes.create buf_len in let rec loop stack = match input ic buf 0 buf_len with @@ -93,9 +95,9 @@ module Sexp = struct in loop Parser.Stack.empty) - let load_many_as_one ~fname = - match load ~fname ~mode:Many with - | [] -> Ast.List (Loc.in_file fname, []) + let load_many_as_one path = + match load path ~mode:Many with + | [] -> Ast.List (Loc.in_file (Path.to_string path), []) | x :: l -> let last = Option.value (List.last l) ~default:x in let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in diff --git a/src/stdune/io.mli b/src/stdune/io.mli index cc1a604a..4ff8583b 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -1,34 +1,34 @@ (** IO operations *) -val open_in : ?binary:bool (* default true *) -> string -> in_channel -val open_out : ?binary:bool (* default true *) -> string -> out_channel +val open_in : ?binary:bool (* default true *) -> Path.t -> in_channel +val open_out : ?binary:bool (* default true *) -> Path.t -> out_channel val close_in : in_channel -> unit val close_out : out_channel -> unit -val with_file_in : ?binary:bool (* default true *) -> string -> f:(in_channel -> 'a) -> 'a -val with_file_out : ?binary:bool (* default true *) -> string -> f:(out_channel -> 'a) -> 'a +val with_file_in : ?binary:bool (* default true *) -> Path.t -> f:(in_channel -> 'a) -> 'a +val with_file_out : ?binary:bool (* default true *) -> Path.t -> f:(out_channel -> 'a) -> 'a -val with_lexbuf_from_file : string -> f:(Lexing.lexbuf -> 'a) -> 'a +val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a -val lines_of_file : string -> string list +val lines_of_file : Path.t -> string list -val read_file : string -> string -val write_file : string -> string -> unit +val read_file : Path.t -> string +val write_file : Path.t -> string -> unit -val compare_files : string -> string -> Ordering.t +val compare_files : Path.t -> Path.t -> Ordering.t -val write_lines : string -> string list -> unit +val write_lines : Path.t -> string list -> unit val copy_channels : in_channel -> out_channel -> unit -val copy_file : src:string -> dst:string -> unit +val copy_file : src:Path.t -> dst:Path.t -> unit val read_all : in_channel -> string module Sexp : sig - val load : fname:string -> mode:'a Sexp.Parser.Mode.t -> 'a - val load_many_as_one : fname:string -> Sexp.Ast.t + val load : Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a + val load_many_as_one : Path.t -> Sexp.Ast.t end (**/**) diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 4da893c1..ec369e39 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -431,6 +431,9 @@ let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = try Sys.is_directory (to_string t) with Sys_error _ -> false +let is_file t = + try Sys.file_exists (to_string t) + with Sys_error _ -> false let rmdir t = Unix.rmdir (to_string t) let win32_unlink fn = try diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 37d30150..1a7d6ae9 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -127,6 +127,7 @@ val insert_after_build_dir_exn : t -> string -> t val exists : t -> bool val readdir : t -> string list val is_directory : t -> bool +val is_file : t -> bool val rmdir : t -> unit val unlink : t -> unit val unlink_no_err : t -> unit diff --git a/src/utils.ml b/src/utils.ml index 257a27f9..f5c481a9 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -183,7 +183,7 @@ module Cached_digest = struct let remove fn = Hashtbl.remove cache fn - let db_file = "_build/.digest-db" + let db_file = Path.of_string "_build/.digest-db" let dump () = let module Pmap = Path.Map in @@ -203,8 +203,8 @@ module Cached_digest = struct Io.write_file db_file (Sexp.to_string sexp) let load () = - if Sys.file_exists db_file then begin - let sexp = Io.Sexp.load ~fname:db_file ~mode:Single in + if Path.is_file db_file then begin + let sexp = Io.Sexp.load db_file ~mode:Single in let bindings = let open Sexp.Of_sexp in list diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index 0c88e584..2de5f14b 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -55,7 +55,7 @@ struct let to_string path x = To_sexp.t path x |> Sexp.to_string let load path = - Of_sexp.t path (Io.Sexp.load ~fname:(Path.to_string path) ~mode:Single) + Of_sexp.t path (Io.Sexp.load path ~mode:Single) end diff --git a/src/watermarks.ml b/src/watermarks.ml index 26827bea..b85e75cf 100644 --- a/src/watermarks.ml +++ b/src/watermarks.ml @@ -19,7 +19,7 @@ let is_a_source_file fn = | _ -> true let make_watermark_map ~name ~version ~commit = - let opam_file = Opam_file.load (name ^ ".opam") in + let opam_file = Opam_file.load (Path.of_string (name ^ ".opam")) in let version_num = if String.is_prefix version ~prefix:"v" then String.sub version ~pos:1 ~len:(String.length version - 1) @@ -62,7 +62,7 @@ let make_watermark_map ~name ~version ~commit = ; "PKG_REPO" , opam_var "dev-repo" " " ] -let subst_string s ~fname ~map = +let subst_string s path ~map = let len = String.length s in let longest_var = String.longest (String.Map.keys map) in let loc_of_offset ~ofs ~len = @@ -70,7 +70,7 @@ let subst_string s ~fname ~map = if i = ofs then let pos = { Lexing. - pos_fname = fname + pos_fname = Path.to_string path ; pos_cnum = i ; pos_lnum = lnum ; pos_bol = bol @@ -151,17 +151,18 @@ let subst_string s ~fname ~map = Buffer.add_substring buf s pos (len - pos); Some (Buffer.contents buf) -let subst_file fn ~map = - let s = Io.read_file fn in +let subst_file path ~map = + let s = Io.read_file path in let s = - if Filename.dirname fn = "." && String.is_suffix fn ~suffix:".opam" then + if Path.is_root path + && String.is_suffix (Path.to_string path) ~suffix:".opam" then "version: \"%%" ^ "VERSION_NUM" ^ "%%\"\n" ^ s else s in - match subst_string s ~map ~fname:fn with + match subst_string s ~map path with | None -> () - | Some s -> Io.write_file fn s + | Some s -> Io.write_file path s let get_name ~files ?name () = let package_names = @@ -223,7 +224,7 @@ let subst_git ?name () = let watermarks = make_watermark_map ~name ~version ~commit in List.iter files ~f:(fun fn -> if is_a_source_file fn then - subst_file fn ~map:watermarks); + subst_file (Path.of_string fn) ~map:watermarks); Fiber.return () let subst ?name () = diff --git a/src/workspace.ml b/src/workspace.ml index 338ea240..fc7b2f89 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -135,4 +135,4 @@ let t ?x sexps = ; contexts = List.rev contexts } -let load ?x fname = t ?x (Io.Sexp.load ~fname ~mode:Many) +let load ?x p = t ?x (Io.Sexp.load p ~mode:Many) diff --git a/src/workspace.mli b/src/workspace.mli index 27463e9c..d4bac52e 100644 --- a/src/workspace.mli +++ b/src/workspace.mli @@ -28,4 +28,4 @@ type t = ; contexts : Context.t list } -val load : ?x:string -> string -> t +val load : ?x:string -> Path.t -> t diff --git a/test/blackbox-tests/cram.mll b/test/blackbox-tests/cram.mll index fc4f9b6c..95510d2b 100644 --- a/test/blackbox-tests/cram.mll +++ b/test/blackbox-tests/cram.mll @@ -143,7 +143,9 @@ and postprocess tbl b = parse | _ -> 255 in let ext_replace = make_ext_replace configurator in - List.iter (Io.lines_of_file temp_file) ~f:(fun line -> + Path.of_string temp_file + |> Io.lines_of_file + |> List.iter ~f:(fun line -> Printf.bprintf buf " %s\n" (ext_replace (Ansi_color.strip line))); if n <> 0 then Printf.bprintf buf " [%d]\n" n); diff --git a/test/unit-tests/tests.mlt b/test/unit-tests/tests.mlt index ca5fa667..0cded15a 100644 --- a/test/unit-tests/tests.mlt +++ b/test/unit-tests/tests.mlt @@ -52,7 +52,8 @@ open Meta #install_printer Simplified.pp;; let meta = - Meta.load ~name:"foo" ~fn:"test/unit-tests/findlib-db/foo/META" + Path.of_string "test/unit-tests/findlib-db/foo/META" + |> Meta.load ~name:"foo" [%%expect{| val meta : Jbuilder.Meta.Simplified.t = From 5eb444e357f61cc1ff811e12a85ecfe73c670420 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 13:25:07 +0700 Subject: [PATCH 04/12] Change Process.run's ~dir argument to use Path.t This also requires Scheduler.with_chdir to use Path.t as well --- src/action.ml | 2 +- src/jbuild_load.ml | 2 +- src/print_diff.ml | 8 ++++---- src/process.ml | 12 ++++++++---- src/process.mli | 8 ++++---- src/scheduler.ml | 2 +- src/scheduler.mli | 4 +++- 7 files changed, 22 insertions(+), 16 deletions(-) diff --git a/src/action.ml b/src/action.ml index 143a428b..e6c4fc21 100644 --- a/src/action.ml +++ b/src/action.ml @@ -735,7 +735,7 @@ let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args = invalid_prefix ("_build/" ^ target.name); invalid_prefix ("_build/install/" ^ target.name); end; - Process.run Strict ~dir:(Path.to_string dir) ~env + Process.run Strict ~dir ~env ~stdout_to ~stderr_to ~purpose:ectx.purpose (Path.reach_for_running ~from:dir prog) args diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index aee09def..7df54961 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -147,7 +147,7 @@ end in ]} *) - Process.run Strict ~dir:(Path.to_string dir) + Process.run Strict ~dir ~env:context.env (Path.to_string context.ocaml) args diff --git a/src/print_diff.ml b/src/print_diff.ml index 8a1639a4..28a43ac3 100644 --- a/src/print_diff.ml +++ b/src/print_diff.ml @@ -9,9 +9,9 @@ let print path1 path2 = Path.extract_build_context_dir path2 with | Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 -> - (Path.to_string dir1, Path.to_string f1, Path.to_string f2) + (dir1, Path.to_string f1, Path.to_string f2) | _ -> - (".", Path.to_string path1, Path.to_string path2) + (Path.root, Path.to_string path1, Path.to_string path2) in let loc = Loc.in_file file1 in let fallback () = @@ -38,10 +38,10 @@ let print path1 path2 = Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd] >>= fun () -> die "command reported no differences: %s" - (if dir = "." then + (if Path.is_root dir then cmd else - sprintf "cd %s && %s" (quote_for_shell dir) cmd) + sprintf "cd %s && %s" (quote_for_shell (Path.to_string dir)) cmd) | None -> match Bin.which "patdiff" with | None -> normal_diff () diff --git a/src/process.ml b/src/process.ml index bde8d5c8..493f77d5 100644 --- a/src/process.ml +++ b/src/process.ml @@ -121,7 +121,7 @@ module Fancy = struct let s = match dir with | None -> s - | Some dir -> sprintf "(cd %s && %s)" dir s + | Some dir -> sprintf "(cd %s && %s)" (Path.to_string dir) s in match stdout_to, stderr_to with | (File fn1 | Opened_file { filename = fn1; _ }), @@ -216,8 +216,12 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose let display = Scheduler.display scheduler in let dir = match dir with - | Some "." -> None - | _ -> dir + | Some p -> + if Path.is_root p then + None + else + Some p + | None -> dir in let id = gen_id () in let ok_codes = accepted_codes fail_mode in @@ -344,7 +348,7 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = let s = String.concat (prog :: args) ~sep:" " in match dir with | None -> s - | Some dir -> sprintf "cd %s && %s" dir s + | Some dir -> sprintf "cd %s && %s" (Path.to_string dir) s in match l with | [] -> diff --git a/src/process.mli b/src/process.mli index a83d7e2c..525eb955 100644 --- a/src/process.mli +++ b/src/process.mli @@ -38,7 +38,7 @@ type purpose = (** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *) val run - : ?dir:string + : ?dir:Path.t -> ?stdout_to:std_output_to -> ?stderr_to:std_output_to -> env:Env.t @@ -50,7 +50,7 @@ val run (** Run a command and capture its output *) val run_capture - : ?dir:string + : ?dir:Path.t -> env:Env.t -> ?purpose:purpose -> (string, 'a) failure_mode @@ -58,7 +58,7 @@ val run_capture -> string list -> 'a Fiber.t val run_capture_line - : ?dir:string + : ?dir:Path.t -> env:Env.t -> ?purpose:purpose -> (string, 'a) failure_mode @@ -66,7 +66,7 @@ val run_capture_line -> string list -> 'a Fiber.t val run_capture_lines - : ?dir:string + : ?dir:Path.t -> env:Env.t -> ?purpose:purpose -> (string list, 'a) failure_mode diff --git a/src/scheduler.ml b/src/scheduler.ml index 065b9938..07aa2dea 100644 --- a/src/scheduler.ml +++ b/src/scheduler.ml @@ -72,7 +72,7 @@ let log t = t.log let display t = t.display let with_chdir t ~dir ~f = - Sys.chdir dir; + Sys.chdir (Path.to_string dir); protectx () ~finally:(fun () -> Sys.chdir t.original_cwd) ~f let hide_status_line s = diff --git a/src/scheduler.mli b/src/scheduler.mli index 4ff2ad4d..a073585c 100644 --- a/src/scheduler.mli +++ b/src/scheduler.mli @@ -1,5 +1,7 @@ (** Scheduling *) +open Stdune + (** [go ?log ?config ?gen_status_line fiber] runs the following fiber until it terminates. [gen_status_line] is used to print a status line when [config.display = Progress]. *) @@ -27,7 +29,7 @@ val wait_for_available_job : unit -> t Fiber.t val log : t -> Log.t (** Execute the given callback with current directory temporarily changed *) -val with_chdir : t -> dir:string -> f:(unit -> 'a) -> 'a +val with_chdir : t -> dir:Path.t -> f:(unit -> 'a) -> 'a (** Display mode for this scheduler *) val display : t -> Config.Display.t From e310f1723747af57ca246c6397efebe2aa9f8dc6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 16:18:32 +0700 Subject: [PATCH 05/12] Get rid of Path.is_file --- src/action.ml | 4 ++-- src/build_system.ml | 6 +++--- src/config.ml | 2 +- src/main.ml | 2 +- src/stdune/path.ml | 3 --- src/stdune/path.mli | 1 - src/utils.ml | 2 +- 7 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/action.ml b/src/action.ml index e6c4fc21..4d91dcf3 100644 --- a/src/action.ml +++ b/src/action.ml @@ -649,7 +649,7 @@ module Promotion = struct let dump_db db = if Sys.file_exists "_build" then begin match db with - | [] -> if Path.is_file db_file then Path.unlink_no_err db_file + | [] -> if Path.exists db_file then Path.unlink_no_err db_file | l -> Io.write_file db_file (String.concat ~sep:"" @@ -657,7 +657,7 @@ module Promotion = struct end let load_db () = - if Path.is_file db_file then + if Path.exists db_file then Io.Sexp.load db_file ~mode:Many |> List.map ~f:File.t else diff --git a/src/build_system.ml b/src/build_system.ml index dfb9205f..3e0bd40b 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -19,7 +19,7 @@ module Promoted_to_delete = struct let add p = db := p :: !db let load () = - if Path.is_file fn then + if Path.exists fn then Io.Sexp.load fn ~mode:Many |> List.map ~f:Path.t else @@ -1123,7 +1123,7 @@ module Trace = struct let load () = let trace = Hashtbl.create 1024 in - if Path.is_file file then begin + if Path.exists file then begin let sexp = Io.Sexp.load file ~mode:Single in let bindings = let open Sexp.Of_sexp in @@ -1203,7 +1203,7 @@ let update_universe t = (* To workaround the fact that [mtime] is not precise enough on OSX *) Utils.Cached_digest.remove universe_file; let n = - if Path.is_file universe_file then + if Path.exists universe_file then Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single universe_file) + 1 else 0 diff --git a/src/config.ml b/src/config.ml index b996c5ac..97565326 100644 --- a/src/config.ml +++ b/src/config.ml @@ -85,7 +85,7 @@ let load_config_file p = t (Io.Sexp.load_many_as_one p) let load_user_config_file () = - if Path.is_file user_config_file then + if Path.exists user_config_file then load_config_file user_config_file else default diff --git a/src/main.ml b/src/main.ml index 81a3004b..14fe46f9 100644 --- a/src/main.ml +++ b/src/main.ml @@ -55,7 +55,7 @@ let setup ?(log=Log.no_log) match workspace with | Some w -> w | None -> - if Path.is_file workspace_file then + if Path.exists workspace_file then Workspace.load ?x workspace_file else { merlin_context = Some "default" diff --git a/src/stdune/path.ml b/src/stdune/path.ml index ec369e39..4da893c1 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -431,9 +431,6 @@ let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = try Sys.is_directory (to_string t) with Sys_error _ -> false -let is_file t = - try Sys.file_exists (to_string t) - with Sys_error _ -> false let rmdir t = Unix.rmdir (to_string t) let win32_unlink fn = try diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 1a7d6ae9..37d30150 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -127,7 +127,6 @@ val insert_after_build_dir_exn : t -> string -> t val exists : t -> bool val readdir : t -> string list val is_directory : t -> bool -val is_file : t -> bool val rmdir : t -> unit val unlink : t -> unit val unlink_no_err : t -> unit diff --git a/src/utils.ml b/src/utils.ml index f5c481a9..31c89d76 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -203,7 +203,7 @@ module Cached_digest = struct Io.write_file db_file (Sexp.to_string sexp) let load () = - if Path.is_file db_file then begin + if Path.exists db_file then begin let sexp = Io.Sexp.load db_file ~mode:Single in let bindings = let open Sexp.Of_sexp in From 729e85716c9a22e788f008e4fc64888c32fbb5ea Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 16:23:47 +0700 Subject: [PATCH 06/12] Port tmp files to use Path.t --- src/process.ml | 29 +++++++++++++---------------- 1 file changed, 13 insertions(+), 16 deletions(-) diff --git a/src/process.ml b/src/process.ml index 493f77d5..bbc93ffd 100644 --- a/src/process.ml +++ b/src/process.ml @@ -49,22 +49,21 @@ type purpose = | Build_job of Path.t list module Temp = struct - let tmp_files = ref String.Set.empty + let tmp_files = ref Path.Set.empty let () = at_exit (fun () -> let fns = !tmp_files in - tmp_files := String.Set.empty; - String.Set.iter fns ~f:(fun fn -> - try Sys.force_remove fn with _ -> ())) + tmp_files := Path.Set.empty; + Path.Set.iter fns ~f:Path.unlink_no_err) let create prefix suffix = - let fn = Filename.temp_file prefix suffix in - tmp_files := String.Set.add !tmp_files fn; + let fn = Path.of_string (Filename.temp_file prefix suffix) in + tmp_files := Path.Set.add !tmp_files fn; fn let destroy fn = - (try Sys.force_remove fn with Sys_error _ -> ()); - tmp_files := String.Set.remove !tmp_files fn + Path.unlink_no_err fn; + tmp_files := Path.Set.remove !tmp_files fn end module Fancy = struct @@ -234,7 +233,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose match stdout_to, stderr_to with | (Terminal, _ | _, Terminal) when !Clflags.capture_outputs -> let fn = Temp.create "jbuilder" ".output" in - let fd = Unix.openfile fn [O_WRONLY; O_SHARE_DELETE] 0 in + let fd = Unix.openfile (Path.to_string fn) [O_WRONLY; O_SHARE_DELETE] 0 in (Some fn, fd, fd, Some fd) | _ -> (None, Unix.stdout, Unix.stderr, None) @@ -259,7 +258,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose match output_filename with | None -> "" | Some fn -> - let s = Io.read_file (Path.of_string fn) in + let s = Io.read_file fn in Temp.destroy fn; let len = String.length s in if len > 0 && s.[len - 1] <> '\n' then @@ -327,20 +326,18 @@ let run ?dir ?stdout_to ?stderr_to ~env ?(purpose=Internal_job) fail_mode let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f = let fn = Temp.create "jbuild" ".output" in map_result fail_mode - (run_internal ?dir ~stdout_to:(File fn) ~env ~purpose fail_mode prog args) + (run_internal ?dir ~stdout_to:(File (Path.to_string fn)) + ~env ~purpose fail_mode prog args) ~f:(fun () -> let x = f fn in Temp.destroy fn; x) -let run_capture = - run_capture_gen ~f:(fun p -> Io.read_file (Path.of_string p)) -let run_capture_lines = - run_capture_gen ~f:(fun p -> Io.lines_of_file (Path.of_string p)) +let run_capture = run_capture_gen ~f:Io.read_file +let run_capture_lines = run_capture_gen ~f:Io.lines_of_file let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = run_capture_gen ?dir ~env ~purpose fail_mode prog args ~f:(fun fn -> - let fn = Path.of_string fn in match Io.lines_of_file fn with | [x] -> x | l -> From b02c61f63c572b5617e441cf49e46073779301a2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 16:30:18 +0700 Subject: [PATCH 07/12] Change the prog arg in Process to Path.t --- bin/main.ml | 3 +-- src/context.ml | 17 +++++++---------- src/jbuild_load.ml | 4 +--- src/print_diff.ml | 7 +++---- src/process.ml | 3 +++ src/process.mli | 8 ++++---- src/stdune/path.mli | 2 +- src/watermarks.ml | 2 +- 8 files changed, 21 insertions(+), 25 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 6323efef..108a5740 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1007,8 +1007,7 @@ let install_uninstall ~what = >>= fun libdir -> Fiber.parallel_iter install_files ~f:(fun path -> let purpose = Process.Build_job install_files in - Process.run ~purpose ~env:setup.env Strict - (Path.to_string opam_installer) + Process.run ~purpose ~env:setup.env Strict opam_installer ([ sprintf "-%c" what.[0] ; Path.to_string path ; "--prefix" diff --git a/src/context.ml b/src/context.ml index 4528c30f..a38ffcfd 100644 --- a/src/context.ml +++ b/src/context.ml @@ -109,7 +109,7 @@ let opam_config_var ~env ~cache var = match Bin.opam with | None -> Fiber.return None | Some fn -> - Process.run_capture (Accept All) (Path.to_string fn) ~env + Process.run_capture (Accept All) fn ~env ["config"; "var"; var] >>| function | Ok s -> @@ -151,7 +151,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = | Some s -> Fiber.return (Path.absolute s) | None -> Process.run_capture_line ~env Strict - (Path.to_string fn) ["printconf"; "conf"] + fn ["printconf"; "conf"] >>| Path.absolute) in @@ -232,7 +232,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = | None -> args | Some s -> "-toolchain" :: s :: args in - Process.run_capture_lines ~env Strict (Path.to_string fn) args + Process.run_capture_lines ~env Strict fn args >>| fun l -> (* Don't prepend the contents of [OCAMLPATH] since findlib does it already *) @@ -258,8 +258,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () = Fiber.fork_and_join findlib_path (fun () -> - Process.run_capture_lines ~env Strict - (Path.to_string ocamlc) ["-config"] + Process.run_capture_lines ~env Strict ocamlc ["-config"] >>| fun lines -> let open Result.O in ocaml_config_ok_exn @@ -411,10 +410,9 @@ let create_for_opam ?root ~env ~targets ~switch ~name ?(merlin=false) () = (match root with | Some root -> Fiber.return root | None -> - Process.run_capture_line Strict ~env - (Path.to_string fn) ["config"; "var"; "root"]) + Process.run_capture_line Strict ~env fn ["config"; "var"; "root"]) >>= fun root -> - Process.run_capture ~env Strict (Path.to_string fn) + Process.run_capture ~env Strict fn ["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"] >>= fun s -> let vars = @@ -465,8 +463,7 @@ let install_ocaml_libdir t = (* If ocamlfind is present, it has precedence over everything else. *) match which t "ocamlfind" with | Some fn -> - (Process.run_capture_line ~env:t.env Strict - (Path.to_string fn) ["printconf"; "destdir"] + (Process.run_capture_line ~env:t.env Strict fn ["printconf"; "destdir"] >>| fun s -> Some (Path.absolute s)) | None -> diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 7df54961..3c8d6a7b 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -147,9 +147,7 @@ end in ]} *) - Process.run Strict ~dir - ~env:context.env - (Path.to_string context.ocaml) + Process.run Strict ~dir ~env:context.env context.ocaml args >>= fun () -> if not (Path.exists generated_jbuild) then diff --git a/src/print_diff.ml b/src/print_diff.ml index 28a43ac3..0cf03568 100644 --- a/src/print_diff.ml +++ b/src/print_diff.ml @@ -24,8 +24,7 @@ let print path1 path2 = | None -> fallback () | Some prog -> Format.eprintf "%a@?" Loc.print loc; - Process.run ~dir ~env:Env.initial Strict (Path.to_string prog) - ["-u"; file1; file2] + Process.run ~dir ~env:Env.initial Strict prog ["-u"; file1; file2] >>= fun () -> fallback () in @@ -35,7 +34,7 @@ let print path1 path2 = let cmd = sprintf "%s %s %s" cmd (quote_for_shell file1) (quote_for_shell file2) in - Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd] + Process.run ~dir ~env:Env.initial Strict sh [arg; cmd] >>= fun () -> die "command reported no differences: %s" (if Path.is_root dir then @@ -46,7 +45,7 @@ let print path1 path2 = match Bin.which "patdiff" with | None -> normal_diff () | Some prog -> - Process.run ~dir ~env:Env.initial Strict (Path.to_string prog) + Process.run ~dir ~env:Env.initial Strict prog [ "-keep-whitespace" ; "-location-style"; "omake" ; if Lazy.force Colors.stderr_supports_colors then diff --git a/src/process.ml b/src/process.ml index bbc93ffd..9a5ab24a 100644 --- a/src/process.ml +++ b/src/process.ml @@ -112,6 +112,7 @@ module Fancy = struct | x :: rest -> x :: colorize_args rest let command_line ~prog ~args ~dir ~stdout_to ~stderr_to = + let prog = Path.to_string prog in let quote = quote_for_shell in let prog = colorize_prog (quote prog) in let s = @@ -228,6 +229,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose if display = Verbose then Format.eprintf "@{Running@}[@{%d@}]: %s@." id (Colors.strip_colors_for_stderr command_line); + let prog = Path.to_string prog in let argv = Array.of_list (prog :: args) in let output_filename, stdout_fd, stderr_fd, to_close = match stdout_to, stderr_to with @@ -342,6 +344,7 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = | [x] -> x | l -> let cmdline = + let prog = Path.to_string prog in let s = String.concat (prog :: args) ~sep:" " in match dir with | None -> s diff --git a/src/process.mli b/src/process.mli index 525eb955..41a53585 100644 --- a/src/process.mli +++ b/src/process.mli @@ -44,7 +44,7 @@ val run -> env:Env.t -> ?purpose:purpose -> (unit, 'a) failure_mode - -> string + -> Path.t -> string list -> 'a Fiber.t @@ -54,7 +54,7 @@ val run_capture -> env:Env.t -> ?purpose:purpose -> (string, 'a) failure_mode - -> string + -> Path.t -> string list -> 'a Fiber.t val run_capture_line @@ -62,7 +62,7 @@ val run_capture_line -> env:Env.t -> ?purpose:purpose -> (string, 'a) failure_mode - -> string + -> Path.t -> string list -> 'a Fiber.t val run_capture_lines @@ -70,7 +70,7 @@ val run_capture_lines -> env:Env.t -> ?purpose:purpose -> (string list, 'a) failure_mode - -> string + -> Path.t -> string list -> 'a Fiber.t diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 37d30150..f4c9984f 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -70,7 +70,7 @@ val absolute : string -> t val to_absolute_filename : t -> root:string -> string val reach : t -> from:t -> string -val reach_for_running : t -> from:t -> string +val reach_for_running : t -> from:t -> t val descendant : t -> of_:t -> t option val is_descendant : t -> of_:t -> bool diff --git a/src/watermarks.ml b/src/watermarks.ml index b85e75cf..98b4c1b4 100644 --- a/src/watermarks.ml +++ b/src/watermarks.ml @@ -201,7 +201,7 @@ let subst_git ?name () = let rev = "HEAD" in let git = match Bin.which "git" with - | Some x -> Path.to_string x + | Some x -> x | None -> Utils.program_not_found "git" in let env = Env.initial in From 63af8747a72d724161b6a65f4fbb110211f8f8fd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 16:33:25 +0700 Subject: [PATCH 08/12] Change std_output_to and opened_file to use Path.t --- src/action.ml | 7 +++++-- src/process.ml | 17 ++++++++++------- src/process.mli | 4 ++-- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/action.ml b/src/action.ml index 4d91dcf3..fb7426ed 100644 --- a/src/action.ml +++ b/src/action.ml @@ -612,7 +612,10 @@ open Fiber.O let get_std_output : _ -> Process.std_output_to = function | None -> Terminal - | Some (fn, oc) -> Opened_file { filename = fn; tail = false; desc = Channel oc } + | Some (fn, oc) -> + Opened_file { filename = (Path.of_string fn) + ; tail = false + ; desc = Channel oc } module Promotion = struct module File = struct @@ -766,7 +769,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Io.write_file fn s; Fiber.return () | Redirect (outputs, fn, Run (Ok prog, args)) -> - let out = Process.File (Path.to_string fn) in + let out = Process.File fn in let stdout_to, stderr_to = match outputs with | Stdout -> (out, get_std_output stderr_to) diff --git a/src/process.ml b/src/process.ml index 9a5ab24a..5b2f52ed 100644 --- a/src/process.ml +++ b/src/process.ml @@ -31,11 +31,11 @@ let map_result type std_output_to = | Terminal - | File of string + | File of Path.t | Opened_file of opened_file and opened_file = - { filename : string + { filename : Path.t ; desc : opened_file_desc ; tail : bool } @@ -126,16 +126,18 @@ module Fancy = struct match stdout_to, stderr_to with | (File fn1 | Opened_file { filename = fn1; _ }), (File fn2 | Opened_file { filename = fn2; _ }) when fn1 = fn2 -> - sprintf "%s &> %s" s fn1 + sprintf "%s &> %s" s (Path.to_string fn1) | _ -> let s = match stdout_to with | Terminal -> s - | File fn | Opened_file { filename = fn; _ } -> sprintf "%s > %s" s fn + | File fn | Opened_file { filename = fn; _ } -> + sprintf "%s > %s" s (Path.to_string fn) in match stderr_to with | Terminal -> s - | File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn + | File fn | Opened_file { filename = fn; _ } -> + sprintf "%s 2> %s" s (Path.to_string fn) let pp_purpose ppf = function | Internal_job -> @@ -190,7 +192,8 @@ end let get_std_output ~default = function | Terminal -> (default, None) | File fn -> - let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in + let fd = Unix.openfile (Path.to_string fn) + [O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in (fd, Some (Fd fd)) | Opened_file { desc; tail; _ } -> let fd = @@ -328,7 +331,7 @@ let run ?dir ?stdout_to ?stderr_to ~env ?(purpose=Internal_job) fail_mode let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f = let fn = Temp.create "jbuild" ".output" in map_result fail_mode - (run_internal ?dir ~stdout_to:(File (Path.to_string fn)) + (run_internal ?dir ~stdout_to:(File fn) ~env ~purpose fail_mode prog args) ~f:(fun () -> let x = f fn in diff --git a/src/process.mli b/src/process.mli index 41a53585..9b16d3f0 100644 --- a/src/process.mli +++ b/src/process.mli @@ -17,11 +17,11 @@ type ('a, 'b) failure_mode = (** Where to redirect standard output *) type std_output_to = | Terminal - | File of string + | File of Path.t | Opened_file of opened_file and opened_file = - { filename : string + { filename : Path.t ; desc : opened_file_desc ; tail : bool (** If [true], the descriptor is closed after starting the command *) From 62aa5acab3455eba84a7f2daca3b841580f18edb Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 16:37:38 +0700 Subject: [PATCH 09/12] Remove some path conversion from Action --- src/action.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/action.ml b/src/action.ml index fb7426ed..1615635e 100644 --- a/src/action.ml +++ b/src/action.ml @@ -613,7 +613,7 @@ open Fiber.O let get_std_output : _ -> Process.std_output_to = function | None -> Terminal | Some (fn, oc) -> - Opened_file { filename = (Path.of_string fn) + Opened_file { filename = fn ; tail = false ; desc = Channel oc } @@ -904,7 +904,6 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = let oc = Io.open_out fn in - let fn = Path.to_string fn in let out = Some (fn, oc) in let stdout_to, stderr_to = match outputs with From 4b2a609396783db8cc85ebdc42b112d490bdca72 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 18:12:45 +0700 Subject: [PATCH 10/12] Ignore Sys_error in Path.exists --- src/stdune/path.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 4da893c1..2ee27dbe 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -426,7 +426,9 @@ let explode_exn t = Exn.code_error "Path.explode_exn" ["path", Sexp.atom_or_quoted_string t] -let exists t = Sys.file_exists (to_string t) +let exists t = + try Sys.file_exists (to_string t) + with Sys_error _ -> false let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = try Sys.is_directory (to_string t) From f44b8bdb1be134b410a6e85e8b7f844e6dfc5671 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 18:22:48 +0700 Subject: [PATCH 11/12] Unhardcode _build dir everywhere --- bin/main.ml | 2 +- src/action.ml | 4 ++-- src/build_system.ml | 10 +++++----- src/context.mli | 2 +- src/log.ml | 5 ++--- src/stdune/path.ml | 6 ++++++ src/stdune/path.mli | 6 ++++++ src/utils.ml | 4 ++-- 8 files changed, 25 insertions(+), 14 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 108a5740..8b0cfd55 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -728,7 +728,7 @@ let clean = set_common common ~targets:[]; Build_system.files_in_source_tree_to_delete () |> List.iter ~f:Path.unlink_no_err; - Path.(rm_rf (append root (of_string "_build"))) + Path.rm_rf Path.build_dir end in ( Term.(const go $ common) diff --git a/src/action.ml b/src/action.ml index 1615635e..18fe861e 100644 --- a/src/action.ml +++ b/src/action.ml @@ -647,10 +647,10 @@ module Promotion = struct Io.copy_file ~src ~dst end - let db_file = Path.of_string "_build/.to-promote" + let db_file = Path.relative_build_dir ".to-promote" let dump_db db = - if Sys.file_exists "_build" then begin + if Path.build_dir_exists () then begin match db with | [] -> if Path.exists db_file then Path.unlink_no_err db_file | l -> diff --git a/src/build_system.ml b/src/build_system.ml index 3e0bd40b..e27fde86 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -14,7 +14,7 @@ let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct let db = ref [] - let fn = Path.of_string "_build/.to-delete-in-source-tree" + let fn = Path.relative_build_dir ".to-delete-in-source-tree" let add p = db := p :: !db @@ -27,7 +27,7 @@ module Promoted_to_delete = struct let dump () = let db = Pset.union (Pset.of_list !db) (Pset.of_list (load ())) in - if Sys.file_exists "_build" then + if Path.build_dir_exists () then Io.write_file fn (String.concat ~sep:"" (List.map (Pset.to_list db) ~f:(fun p -> @@ -1106,7 +1106,7 @@ let stamp_file_for_files_of t ~dir ~ext = module Trace = struct type t = (Path.t, Digest.t) Hashtbl.t - let file = Path.of_string "_build/.db" + let file = Path.relative_build_dir ".db" let dump (trace : t) = let sexp = @@ -1118,7 +1118,7 @@ module Trace = struct Sexp.List [ Path.sexp_of_t path; Atom (Sexp.Atom.of_digest hash) ])) in - if Sys.file_exists "_build" then + if Path.build_dir_exists () then Io.write_file file (Sexp.to_string sexp) let load () = @@ -1451,7 +1451,7 @@ let get_collector t ~dir = (if Path.is_in_source_tree dir then "Build_system.get_collector called on source directory" else if dir = Path.build_dir then - "Build_system.get_collector called on _build" + "Build_system.get_collector called on build_dir" else if not (Path.is_local dir) then "Build_system.get_collector called on external directory" else diff --git a/src/context.mli b/src/context.mli index 461bba23..b3fcc57c 100644 --- a/src/context.mli +++ b/src/context.mli @@ -8,7 +8,7 @@ - opam switch contexts, where one opam switch correspond to one context - each context is built into a sub-directory of "_build": + each context is built into a sub-directory of Path.build_dir (usually _build): - _build/default for the default context - _build/ for other contexts diff --git a/src/log.ml b/src/log.ml index c78811d3..51a8b389 100644 --- a/src/log.ml +++ b/src/log.ml @@ -12,9 +12,8 @@ type t = real option let no_log = None let create ?(display=Config.default.display) () = - if not (Sys.file_exists "_build") then - Unix.mkdir "_build" 0o777; - let oc = Io.open_out (Path.of_string "_build/log") in + Path.ensure_build_dir_exists (); + let oc = Io.open_out (Path.relative_build_dir "log") in Printf.fprintf oc "# %s\n# OCAMLPARAM: %s\n%!" (String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ") (match Env.get Env.initial "OCAMLPARAM" with diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 2ee27dbe..8c592f04 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -453,6 +453,12 @@ let unlink t = unlink_operation (to_string t) let unlink_no_err t = try unlink t with _ -> () +let build_dir_exists () = is_directory build_dir + +let ensure_build_dir_exists () = Local.mkdir_p build_dir + +let relative_build_dir = relative build_dir + let extend_basename t ~suffix = t ^ suffix let insert_after_build_dir_exn = diff --git a/src/stdune/path.mli b/src/stdune/path.mli index f4c9984f..ecaee546 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -146,3 +146,9 @@ val extension : t -> string val drop_prefix : t -> prefix:t -> string option val pp : Format.formatter -> t -> unit + +val build_dir_exists : unit -> bool + +val ensure_build_dir_exists : unit -> unit + +val relative_build_dir : string -> t diff --git a/src/utils.ml b/src/utils.ml index 31c89d76..75a593a1 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -183,7 +183,7 @@ module Cached_digest = struct let remove fn = Hashtbl.remove cache fn - let db_file = Path.of_string "_build/.digest-db" + let db_file = Path.relative_build_dir ".digest-db" let dump () = let module Pmap = Path.Map in @@ -199,7 +199,7 @@ module Cached_digest = struct (Int64.bits_of_float file.timestamp)) ])) in - if Sys.file_exists "_build" then + if Path.build_dir_exists () then Io.write_file db_file (Sexp.to_string sexp) let load () = From a1835c7fa0280879fc04c155e5ab37689c0cd063 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 20:16:19 +0700 Subject: [PATCH 12/12] s/relative_build_dir/relative_to_build_dir/ --- src/action.ml | 2 +- src/build_system.ml | 4 ++-- src/log.ml | 2 +- src/stdune/path.ml | 2 +- src/stdune/path.mli | 2 +- src/utils.ml | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/action.ml b/src/action.ml index 18fe861e..b2aa998b 100644 --- a/src/action.ml +++ b/src/action.ml @@ -647,7 +647,7 @@ module Promotion = struct Io.copy_file ~src ~dst end - let db_file = Path.relative_build_dir ".to-promote" + let db_file = Path.relative_to_build_dir ".to-promote" let dump_db db = if Path.build_dir_exists () then begin diff --git a/src/build_system.ml b/src/build_system.ml index e27fde86..f2603f32 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -14,7 +14,7 @@ let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct let db = ref [] - let fn = Path.relative_build_dir ".to-delete-in-source-tree" + let fn = Path.relative_to_build_dir ".to-delete-in-source-tree" let add p = db := p :: !db @@ -1106,7 +1106,7 @@ let stamp_file_for_files_of t ~dir ~ext = module Trace = struct type t = (Path.t, Digest.t) Hashtbl.t - let file = Path.relative_build_dir ".db" + let file = Path.relative_to_build_dir ".db" let dump (trace : t) = let sexp = diff --git a/src/log.ml b/src/log.ml index 51a8b389..72290b45 100644 --- a/src/log.ml +++ b/src/log.ml @@ -13,7 +13,7 @@ let no_log = None let create ?(display=Config.default.display) () = Path.ensure_build_dir_exists (); - let oc = Io.open_out (Path.relative_build_dir "log") in + let oc = Io.open_out (Path.relative_to_build_dir "log") in Printf.fprintf oc "# %s\n# OCAMLPARAM: %s\n%!" (String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ") (match Env.get Env.initial "OCAMLPARAM" with diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 8c592f04..4cdac5b9 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -457,7 +457,7 @@ let build_dir_exists () = is_directory build_dir let ensure_build_dir_exists () = Local.mkdir_p build_dir -let relative_build_dir = relative build_dir +let relative_to_build_dir = relative build_dir let extend_basename t ~suffix = t ^ suffix diff --git a/src/stdune/path.mli b/src/stdune/path.mli index ecaee546..a23c18d5 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -151,4 +151,4 @@ val build_dir_exists : unit -> bool val ensure_build_dir_exists : unit -> unit -val relative_build_dir : string -> t +val relative_to_build_dir : string -> t diff --git a/src/utils.ml b/src/utils.ml index 75a593a1..e8b28c59 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -183,7 +183,7 @@ module Cached_digest = struct let remove fn = Hashtbl.remove cache fn - let db_file = Path.relative_build_dir ".digest-db" + let db_file = Path.relative_to_build_dir ".digest-db" let dump () = let module Pmap = Path.Map in