Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Upgrade to OCamlformat 0.27.0 #11059

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
version=0.26.2
version=0.27.0
profile=janestreet
ocaml-version=4.08.0
44 changes: 22 additions & 22 deletions bench/bench.ml
Original file line number Diff line number Diff line change
Expand Up @@ -180,28 +180,28 @@ let tag_results { size; clean; zero } =
- stack_size - not very useful
- forced_collections - only available in OCaml >= 4.12 *)
let display_clean_and_zero_with_sandboxing
({ elapsed_time
; user_cpu_time
; system_cpu_time
; minor_words
; promoted_words
; major_words
; minor_collections
; major_collections
; heap_words
; heap_chunks
; live_words
; live_blocks
; free_words
; free_blocks
; largest_free
; fragments = _
; compactions
; top_heap_words
; stack_size = _
} :
_ Metrics.t)
(zero : _ Metrics.t)
({ elapsed_time
; user_cpu_time
; system_cpu_time
; minor_words
; promoted_words
; major_words
; minor_collections
; major_collections
; heap_words
; heap_chunks
; live_words
; live_blocks
; free_words
; free_blocks
; largest_free
; fragments = _
; compactions
; top_heap_words
; stack_size = _
} :
_ Metrics.t)
(zero : _ Metrics.t)
=
let display what units clean zero =
{ Output.name = what
Expand Down
4 changes: 3 additions & 1 deletion bench/gen_synthetic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -8,10 +8,12 @@ let write_modules basedir num_modules =
done
;;

let dune = {|
let dune =
{|
(library
(name test))
|}
;;

let write basedir =
let () = Unix.mkdir basedir 0o777 in
Expand Down
20 changes: 12 additions & 8 deletions bench/gen_synthetic_dune_watch.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,10 @@ let write_subset base_dir library_index subset =
List.flatten
(List.map
(fun k ->
List.map
(fun j ->
sprintf "M_%d_%d_%d_%d.f()" (library_index - 1) j mod_rows k)
(count subsets_per_library))
List.map
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like that the function bodies are indented by two from the fun and not from the ( in front of fun. Seems more consistent.

(fun j ->
sprintf "M_%d_%d_%d_%d.f()" (library_index - 1) j mod_rows k)
(count subsets_per_library))
(count mod_cols))
else
List.map
Expand Down Expand Up @@ -68,17 +68,21 @@ let write_lib ~base_dir ~lib ~dune =

let write base_dir =
let () = Unix.mkdir base_dir 0o777 in
let dune = {|
let dune =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems a bit wasteful.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was changed in ocaml-ppx/ocamlformat#2480 but perhaps with a different case in mind.
@dvulakh Do you have an opinion ?

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

When formatting with --profile=janestreet, we want to keep the new behavior (multiline delimited strings always get their own lines).

We don't mind if --profile=ocamlformat or --profile=default keep some multiline strings docked, though.

{|
(library
(name leaf)
(libraries internal))
|} in
|}
in
write_lib ~base_dir ~lib:Leaf ~dune;
let dune = {|
let dune =
{|
(library
(name internal)
(wrapped false))
|} in
|}
in
write_lib ~base_dir ~lib:Internal ~dune
;;

Expand Down
22 changes: 11 additions & 11 deletions bench/metrics.mli
Original file line number Diff line number Diff line change
Expand Up @@ -6,41 +6,41 @@ open Stdune
[unzip] functions which make serialisation easier. *)
type ('float, 'int) t =
{ elapsed_time : 'float
(** Real time elapsed since the process started and the process
(** Real time elapsed since the process started and the process
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like that the comments beginnings are aligned with the field they're documenting.

finished. *)
; user_cpu_time : 'float
(** The amount of CPU time spent in user mode during the process. Other
(** The amount of CPU time spent in user mode during the process. Other
processes and blocked time are not included. *)
; system_cpu_time : 'float
(** The amount of CPU time spent in kernel mode during the process.
(** The amount of CPU time spent in kernel mode during the process.
Similar to user time, other processes and time spent blocked by
other processes are not counted. *)
; minor_words : 'float
(** Number of words allocated in the minor heap since the program was
(** Number of words allocated in the minor heap since the program was
started. *)
; promoted_words : 'float
(** Number of words that have been promoted from the minor to the major
(** Number of words that have been promoted from the minor to the major
heap since the program was started. *)
; major_words : 'float
(** Number of words allocated in the major heap since the program was
(** Number of words allocated in the major heap since the program was
started. *)
; minor_collections : 'int
(** Number of minor collections since the program was started. *)
(** Number of minor collections since the program was started. *)
; major_collections : 'int
(** Number of major collection cycles completed since the program was
(** Number of major collection cycles completed since the program was
started. *)
; heap_words : 'int (** Total size of the major heap, in words. *)
; heap_chunks : 'int
(** Number of contiguous pieces of memory that make up the major heap. *)
(** Number of contiguous pieces of memory that make up the major heap. *)
; live_words : 'int
(** Number of words of live data in the major heap, including the header
(** Number of words of live data in the major heap, including the header
words. *)
; live_blocks : 'int (** Number of live blocks in the major heap. *)
; free_words : 'int (** Number of words in the free list. *)
; free_blocks : 'int (** Number of blocks in the free list. *)
; largest_free : 'int (** Size (in words) of the largest block in the free list. *)
; fragments : 'int
(** Number of wasted words due to fragmentation. These are 1-words free
(** Number of wasted words due to fragmentation. These are 1-words free
blocks placed between two live blocks. They are not available for
allocation. *)
; compactions : 'int (** Number of heap compactions since the program was started. *)
Expand Down
67 changes: 34 additions & 33 deletions bench/micro/path_bench.ml
Original file line number Diff line number Diff line change
Expand Up @@ -8,56 +8,57 @@ let root = "."
let short_path = "a/b/c"
let long_path = List.init 20 ~f:(fun _ -> "foo-bar-baz") |> String.concat ~sep:"/"

let%bench_fun ("is_root" [@params
path
= [ "root", "."
; "short path", short_path
; "long path", long_path
]])
let%bench_fun
("is_root"
[@params path = [ "root", "."; "short path", short_path; "long path", long_path ]])
=
fun () -> ignore (Fpath.is_root path)
;;

let%bench_fun ("reach" [@params
t
= [ "from root long path", (long_path, root)
; "from root short path", (short_path, root)
; "reach root from short path", (root, short_path)
; "reach root from long path", (root, long_path)
; ( "reach long path from similar long path"
, ( Filename.concat long_path "a"
, Filename.concat long_path "b" ) )
; ( "reach short path from similar short path"
, ( Filename.concat short_path "a"
, Filename.concat short_path "b" ) )
]])
let%bench_fun
("reach"
[@params
t
= [ "from root long path", (long_path, root)
; "from root short path", (short_path, root)
; "reach root from short path", (root, short_path)
; "reach root from long path", (root, long_path)
; ( "reach long path from similar long path"
, (Filename.concat long_path "a", Filename.concat long_path "b") )
; ( "reach short path from similar short path"
, (Filename.concat short_path "a", Filename.concat short_path "b") )
]])
=
let t, from = t in
let t = Path.of_string t in
let from = Path.of_string from in
fun () -> ignore (Path.reach t ~from)
;;

let%bench_fun ("Path.Local.relative" [@params
t
= [ "left root", (".", long_path)
; "right root", (long_path, ".")
; "short paths", (short_path, short_path)
; "long paths", (long_path, long_path)
]])
let%bench_fun
("Path.Local.relative"
[@params
t
= [ "left root", (".", long_path)
; "right root", (long_path, ".")
; "short paths", (short_path, short_path)
; "long paths", (long_path, long_path)
]])
=
let x, y = t in
let x = Path.Local.of_string x in
fun () -> ignore (Path.Local.relative x y)
;;

let%bench_fun ("Path.Local.append" [@params
t
= [ "left root", (".", long_path)
; "right root", (long_path, ".")
; "short paths", (short_path, short_path)
; "long paths", (long_path, long_path)
]])
let%bench_fun
("Path.Local.append"
[@params
t
= [ "left root", (".", long_path)
; "right root", (long_path, ".")
; "short paths", (short_path, short_path)
; "long paths", (long_path, long_path)
]])
=
let x, y = t in
let x = Path.Local.of_string x in
Expand Down
63 changes: 32 additions & 31 deletions bin/build_cmd.ml
Original file line number Diff line number Diff line change
Expand Up @@ -37,46 +37,47 @@ let run_build_system ~common ~request =
let open Fiber.O in
Fiber.finalize
(fun () ->
(* CR-someday amokhov: Currently we invalidate cached timestamps on every
(* CR-someday amokhov: Currently we invalidate cached timestamps on every
incremental rebuild. This conservative approach helps us to work around
some [mtime] resolution problems (e.g. on Mac OS). It would be nice to
find a way to avoid doing this. In fact, this may be unnecessary even
for the initial build if we assume that the user does not modify files
in the [_build] directory. For now, it's unclear if optimising this is
worth the effort. *)
Cached_digest.invalidate_cached_timestamps ();
let* setup = Import.Main.setup () in
let request =
Action_builder.bind (Action_builder.of_memo setup) ~f:(fun setup -> request setup)
in
(* CR-someday cmoseley: Can we avoid creating a new lazy memo node every
Cached_digest.invalidate_cached_timestamps ();
let* setup = Import.Main.setup () in
let request =
Action_builder.bind (Action_builder.of_memo setup) ~f:(fun setup ->
request setup)
in
(* CR-someday cmoseley: Can we avoid creating a new lazy memo node every
time the build system is rerun? *)
(* This top-level node is used for traversing the whole Memo graph. *)
let toplevel_cell, toplevel =
Memo.Lazy.Expert.create ~name:"toplevel" (fun () ->
let open Memo.O in
let+ (), (_ : Dep.Fact.t Dep.Map.t) =
Action_builder.evaluate_and_collect_facts request
in
())
in
let* res = run ~toplevel in
let+ () =
match Common.dump_memo_graph_file common with
| None -> Fiber.return ()
| Some file ->
let path = Path.external_ file in
let+ graph =
Memo.dump_cached_graph
~time_nodes:(Common.dump_memo_graph_with_timing common)
toplevel_cell
in
Graph.serialize graph ~path ~format:(Common.dump_memo_graph_format common)
(* CR-someday cmoseley: It would be nice to use Persistent to dump a
(* This top-level node is used for traversing the whole Memo graph. *)
let toplevel_cell, toplevel =
Memo.Lazy.Expert.create ~name:"toplevel" (fun () ->
let open Memo.O in
let+ (), (_ : Dep.Fact.t Dep.Map.t) =
Action_builder.evaluate_and_collect_facts request
in
())
in
let* res = run ~toplevel in
let+ () =
match Common.dump_memo_graph_file common with
| None -> Fiber.return ()
| Some file ->
let path = Path.external_ file in
let+ graph =
Memo.dump_cached_graph
~time_nodes:(Common.dump_memo_graph_with_timing common)
toplevel_cell
in
Graph.serialize graph ~path ~format:(Common.dump_memo_graph_format common)
(* CR-someday cmoseley: It would be nice to use Persistent to dump a
copy of the graph's internal representation here, so it could be used
without needing to re-run the build*)
in
res)
in
res)
~finally:(fun () ->
Hooks.End_of_build.run ();
Fiber.return ())
Expand Down
7 changes: 4 additions & 3 deletions bin/describe/aliases_targets.ml
Original file line number Diff line number Diff line change
Expand Up @@ -24,9 +24,10 @@ let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) =
(* We only drop the build context if it is correct. *)
match Path.Build.extract_build_context d with
| Some (dir_context_name, d) ->
if Dune_engine.Context_name.equal
context
(Dune_engine.Context_name.of_string dir_context_name)
if
Dune_engine.Context_name.equal
context
(Dune_engine.Context_name.of_string dir_context_name)
then d
else
User_error.raise
Expand Down
Loading
Loading