Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Format sources with ocamlformat and enforce formatting in CI #565

Merged
merged 2 commits into from
Jun 18, 2022
Merged

Format sources with ocamlformat and enforce formatting in CI #565

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
464f673
Enforce formatting in CI
cknitt Jun 16, 2022
766d61d
Reformat sources.
cknitt Jun 18, 2022
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
3 changes: 3 additions & 0 deletions .github/workflows/ci.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,9 @@ jobs:
- name: Install dependencies
run: opam install . --deps-only

- name: Check format
run: opam exec -- dune build @fmt

- name: Build executables
run: opam exec -- dune build

Expand Down
196 changes: 103 additions & 93 deletions benchmarks/Benchmark.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@ module CommentTable = Res_comments_table
module Parser = Res_parser
module Printer = Res_printer

module IO: sig
val readFile: string -> string
module IO : sig
val readFile : string -> string
end = struct
(* random chunk size: 2^15, TODO: why do we guess randomly? *)
let chunkSize = 32768
Expand All @@ -15,39 +15,40 @@ end = struct
let buffer = Buffer.create chunkSize in
let chunk = (Bytes.create [@doesNotRaise]) chunkSize in
let rec loop () =
let len = try input chan chunk 0 chunkSize with Invalid_argument _ -> 0 in
let len =
try input chan chunk 0 chunkSize with Invalid_argument _ -> 0
in
if len == 0 then (
close_in_noerr chan;
Buffer.contents buffer
) else (
Buffer.contents buffer)
else (
Buffer.add_subbytes buffer chunk 0 len;
loop ()
)
loop ())
in
loop ()
end

module Time: sig
module Time : sig
type t

val now: unit -> t
val now : unit -> t

val toUint64: t -> int64 [@@live]
val toUint64 : t -> int64 [@@live]

(* let of_uint64_ns ns = ns *)

val nanosecond: t [@@live]
val microsecond: t [@@live]
val millisecond: t [@@live]
val second: t [@@live]
val minute: t [@@live]
val hour: t [@@live]
val nanosecond : t [@@live]
val microsecond : t [@@live]
val millisecond : t [@@live]
val second : t [@@live]
val minute : t [@@live]
val hour : t [@@live]

val zero: t
val zero : t

val diff: t -> t -> t
val add: t -> t -> t
val print: t -> float
val diff : t -> t -> t
val add : t -> t -> t
val print : t -> float
end = struct
(* nanoseconds *)
type t = int64
Expand All @@ -64,22 +65,21 @@ end = struct
let hour = Int64.mul 60L minute

(* TODO: we could do this inside caml_absolute_time *)
external init: unit -> unit = "caml_mach_initialize"
let () = init()
external now: unit -> t = "caml_mach_absolute_time"
external init : unit -> unit = "caml_mach_initialize"
let () = init ()
external now : unit -> t = "caml_mach_absolute_time"

let diff t1 t2 = Int64.sub t2 t1
let add t1 t2 = Int64.add t1 t2
let print t =
(Int64.to_float t) *. 1e-6
let print t = Int64.to_float t *. 1e-6
end

module Benchmark: sig
module Benchmark : sig
type t

val make: name:string -> f:(t -> unit) -> unit -> t
val launch: t -> unit
val report: t -> unit
val make : name:string -> f:(t -> unit) -> unit -> t
val launch : t -> unit
val report : t -> unit
end = struct
type t = {
name: string;
Expand All @@ -89,7 +89,7 @@ end = struct
benchFunc: t -> unit;
mutable timerOn: bool;
(* mutable result: benchmarkResult; *)
(* The initial states *)
(* The initial states *)
mutable startAllocs: float;
mutable startBytes: float;
(* The net total of this test after being run. *)
Expand All @@ -100,65 +100,69 @@ end = struct
let report b =
print_endline (Format.sprintf "Benchmark: %s" b.name);
print_endline (Format.sprintf "Nbr of iterations: %d" b.n);
print_endline (Format.sprintf "Benchmark ran during: %fms" (Time.print b.duration));
print_endline (Format.sprintf "Avg time/op: %fms" ((Time.print b.duration) /. (float_of_int b.n)));
print_endline (Format.sprintf "Allocs/op: %d" (int_of_float (b.netAllocs /. (float_of_int b.n))));
print_endline (Format.sprintf "B/op: %d" (int_of_float (b.netBytes /. (float_of_int b.n))));
(* return (float64(r.Bytes) * float64(r.N) / 1e6) / r.T.Seconds() *)

print_endline
(Format.sprintf "Benchmark ran during: %fms" (Time.print b.duration));
print_endline
(Format.sprintf "Avg time/op: %fms"
(Time.print b.duration /. float_of_int b.n));
print_endline
(Format.sprintf "Allocs/op: %d"
(int_of_float (b.netAllocs /. float_of_int b.n)));
print_endline
(Format.sprintf "B/op: %d"
(int_of_float (b.netBytes /. float_of_int b.n)));

print_newline();
(* return (float64(r.Bytes) * float64(r.N) / 1e6) / r.T.Seconds() *)
print_newline ();
()

let make ~name ~f () = {
name;
start = Time.zero;
n = 0;
benchFunc = f;
duration = Time.zero;
timerOn = false;
startAllocs = 0.;
startBytes = 0.;
netAllocs = 0.;
netBytes = 0.;
}
let make ~name ~f () =
{
name;
start = Time.zero;
n = 0;
benchFunc = f;
duration = Time.zero;
timerOn = false;
startAllocs = 0.;
startBytes = 0.;
netAllocs = 0.;
netBytes = 0.;
}

(* total amount of memory allocated by the program since it started in words *)
let mallocs () =
let stats = Gc.quick_stat() in
let stats = Gc.quick_stat () in
stats.minor_words +. stats.major_words -. stats.promoted_words

let startTimer b =
if not b.timerOn then (
let allocatedWords = mallocs() in
let allocatedWords = mallocs () in
b.startAllocs <- allocatedWords;
b.startBytes <- allocatedWords *. 8.;
b.start <- Time.now();
b.timerOn <- true
)
b.start <- Time.now ();
b.timerOn <- true)

let stopTimer b =
if b.timerOn then (
let allocatedWords = mallocs() in
let diff = (Time.diff b.start (Time.now())) in
let allocatedWords = mallocs () in
let diff = Time.diff b.start (Time.now ()) in
b.duration <- Time.add b.duration diff;
b.netAllocs <- b.netAllocs +. (allocatedWords -. b.startAllocs);
b.netBytes <- b.netBytes +. (allocatedWords *. 8. -. b.startBytes);
b.timerOn <- false
)
b.netBytes <- b.netBytes +. ((allocatedWords *. 8.) -. b.startBytes);
b.timerOn <- false)

let resetTimer b =
if b.timerOn then (
let allocatedWords = mallocs() in
let allocatedWords = mallocs () in
b.startAllocs <- allocatedWords;
b.netAllocs <- allocatedWords *. 8.;
b.start <- Time.now();
);
b.start <- Time.now ());
b.netAllocs <- 0.;
b.netBytes <- 0.

let runIteration b n =
Gc.full_major();
Gc.full_major ();
b.n <- n;
resetTimer b;
startTimer b;
Expand All @@ -167,22 +171,24 @@ end = struct

let launch b =
(* 150 runs * all the benchmarks means around 1m of benchmark time *)
for n=1 to 150 do
for n = 1 to 150 do
runIteration b n
done
end

module Benchmarks: sig
val run: unit -> unit
module Benchmarks : sig
val run : unit -> unit
end = struct
type action = Parse | Print
let string_of_action action = match action with
| Parse -> "parser"
| Print -> "printer"
let string_of_action action =
match action with
| Parse -> "parser"
| Print -> "printer"

(* TODO: we could at Reason here *)
type lang = Ocaml | Rescript
let string_of_lang lang = match lang with
let string_of_lang lang =
match lang with
| Ocaml -> "ocaml"
| Rescript -> "rescript"

Expand All @@ -194,33 +200,37 @@ end = struct
let parseRescript src filename =
let p = Parser.make src filename in
let structure = ResParser.parseImplementation p in
assert(p.diagnostics == []);
assert (p.diagnostics == []);
structure

let benchmark filename lang action =
let src = IO.readFile filename in
let name =
filename ^ " " ^ (string_of_lang lang) ^ " " ^ (string_of_action action)
filename ^ " " ^ string_of_lang lang ^ " " ^ string_of_action action
in
let benchmarkFn = match (lang, action) with
| (Rescript, Parse) -> (fun _ ->
let _ = Sys.opaque_identity (parseRescript src filename) in ()
)
| (Ocaml, Parse) -> (fun _ ->
let _ = Sys.opaque_identity (parseOcaml src filename) in ()
)
| (Rescript, Print) ->
let p = Parser.make src filename in
let ast = ResParser.parseImplementation p in
(fun _ ->
let _ = Sys.opaque_identity (
let cmtTbl = CommentTable.make () in
let comments = List.rev p.Parser.comments in
let () = CommentTable.walkStructure ast cmtTbl comments in
Doc.toString ~width:80 (Printer.printStructure ast cmtTbl)
) in ()
)
| _ -> (fun _ -> ())
let benchmarkFn =
match (lang, action) with
| Rescript, Parse ->
fun _ ->
let _ = Sys.opaque_identity (parseRescript src filename) in
()
| Ocaml, Parse ->
fun _ ->
let _ = Sys.opaque_identity (parseOcaml src filename) in
()
| Rescript, Print ->
let p = Parser.make src filename in
let ast = ResParser.parseImplementation p in
fun _ ->
let _ =
Sys.opaque_identity
(let cmtTbl = CommentTable.make () in
let comments = List.rev p.Parser.comments in
let () = CommentTable.walkStructure ast cmtTbl comments in
Doc.toString ~width:80 (Printer.printStructure ast cmtTbl))
in
()
| _ -> fun _ -> ()
in
let b = Benchmark.make ~name ~f:benchmarkFn () in
Benchmark.launch b;
Expand All @@ -236,7 +246,7 @@ end = struct
benchmark "./benchmarks/data/Napkinscript.res" Rescript Print;
benchmark "./benchmarks/data/HeroGraphic.res" Rescript Parse;
benchmark "./benchmarks/data/HeroGraphic.ml" Ocaml Parse;
benchmark "./benchmarks/data/HeroGraphic.res" Rescript Print;
benchmark "./benchmarks/data/HeroGraphic.res" Rescript Print
end

let () = Benchmarks.run()
let () = Benchmarks.run ()
Loading