Skip to content

Dream eml performance boost #397

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.

Sign up for GitHub

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

Open
katel0k wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Dream eml performance boost #397

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
5ee5d46
Made use of buffer pool
katel0k Mar 23, 2025
71aa6f1
Added reason syntax and removed mutex
katel0k Jun 1, 2025
7e2f269
Added options for controlling buffer pool size
katel0k Jun 1, 2025
44673a1
Used named parameters
katel0k Jun 1, 2025
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
71 changes: 61 additions & 10 deletions src/eml/eml.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,11 @@ type 'a with_location = {
what : 'a;
}

type start_file_token = [
(* Token for the start of file. Will be replaced with code creating buffer pool *)
| `Start_file
]

type code_block_token = [
(* A block of OCaml code. These start at the beginning of the input file, and
continue until a line that starts with '<'. They occur again whenever the
Expand Down Expand Up @@ -99,6 +104,7 @@ type template_token = [
]

type token = [
| start_file_token
| code_block_token
| options_token
| newline_token
Expand All @@ -111,6 +117,8 @@ sig
end =
struct
let show = function
| `Start_file ->
"Start of file"
| `Code_block {line; column; what = code} ->
Printf.sprintf "(%i, %i) Code_block\n%s" (line + 1) column code
| `Options (options, indent) ->
Expand Down Expand Up @@ -423,13 +431,14 @@ struct

let scan stream =
stream
|> at_code_block [] ""
|> at_code_block [`Start_file] ""
|> List.rev
end



type template = [
| start_file_token
| code_block_token
| `Template of (string * int) * template_token list list
]
Expand Down Expand Up @@ -471,6 +480,8 @@ struct
at the start of every template, carrying indentation information. So,
it should be removed at the next opportunity. *)
template_level ("", 0) accumulator [] [] tokens
| (`Start_file as token)::tokens ->
top_level (token::accumulator) tokens
| (`Code_block _ as token)::tokens ->
top_level (token::accumulator) tokens
| [] ->
Expand All @@ -485,6 +496,8 @@ struct
top_level ((`Template (options, List.rev template))::accumulator) tokens
| `Newline::tokens ->
template_level options accumulator ((List.rev line)::template) [] tokens
| (`Start_file as token)::tokens ->
top_level (token::accumulator) tokens
| (#template_token as token)::tokens ->
template_level options accumulator template (token::line) tokens

Expand All @@ -498,7 +511,7 @@ struct
templates
|> List.map (function
| `Template (options, template) -> `Template (options, f options template)
| `Code_block _ as token -> token)
| (`Code_block _) | `Start_file as token -> token)



Expand Down Expand Up @@ -631,7 +644,7 @@ end
module Generate :
sig
val generate :
reason:bool -> string -> (string -> unit) -> template list -> unit
reason:bool -> buffer_size:int -> pool_size:int -> string -> (string -> unit) -> template list -> unit
end =
struct
type output = {
Expand All @@ -643,14 +656,51 @@ struct
format_end : unit -> unit;
}

let buffer_pool buffer_size pool_size =
Printf.sprintf {|let ___EML_BUFFER_SIZE = %d
let ___EML_POOL_SIZE = %d
let ___eml_pool = ref (List.init ___EML_POOL_SIZE (fun _ -> Buffer.create ___EML_BUFFER_SIZE))
let ___eml_get_buffer pool =
match !pool with
| buf :: bufs ->
pool := bufs;
Buffer.clear buf;
buf
| [] -> Buffer.create ___EML_BUFFER_SIZE
let ___eml_return_buffer pool buf =
pool := buf :: !pool;
Buffer.contents buf

|} buffer_size pool_size

let buffer_pool_reason buffer_size pool_size =
Printf.sprintf {|let ___EML_BUFFER_SIZE = %d;
let ___EML_POOL_SIZE = %d;
let ___eml_pool = ref(List.init(___EML_POOL_SIZE, _ => Buffer.create(___EML_BUFFER_SIZE)));
let ___eml_get_buffer = pool => {
switch (pool^) {
| [buf, ...bufs] =>
pool := bufs;
Buffer.clear(buf);
buf;
| [] => Buffer.create(___EML_BUFFER_SIZE)
};
};
let ___eml_return_buffer = (pool, buf) => {
pool := [buf, ...pool^];
Buffer.contents(buf);
};

|} buffer_size pool_size

let string print = {
print;

init = (fun () ->
print "let ___eml_buffer = Buffer.create 4096 in\n");
print "let ___eml_buffer = ___eml_get_buffer ___eml_pool in\n");

finish = (fun () ->
print "(Buffer.contents ___eml_buffer)\n");
print "(___eml_return_buffer ___eml_pool ___eml_buffer)\n");

text =
Printf.ksprintf print "(Buffer.add_string ___eml_buffer %S);\n";
Expand All @@ -666,10 +716,10 @@ struct
print;

init = (fun () ->
print "let ___eml_buffer = Buffer.create(4096);\n");
print "let ___eml_buffer = ___eml_get_buffer(___eml_pool);\n");

finish = (fun () ->
print "Buffer.contents(___eml_buffer)\n");
print "___eml_return_buffer(___eml_pool, ___eml_buffer)\n");

text =
Printf.ksprintf print "Buffer.add_string(___eml_buffer, %S);\n";
Expand Down Expand Up @@ -756,8 +806,9 @@ struct
output.format_end ();
end

let generate ~reason location print templates =
let generate ~reason ~buffer_size ~pool_size location print templates =
templates |> List.iter begin function
| `Start_file -> print @@ (if reason then buffer_pool_reason else buffer_pool) buffer_size pool_size
| `Code_block {line; what; _} ->
Printf.ksprintf print "#%i \"%s\"\n" (line + 1) location;
print what
Expand All @@ -782,7 +833,7 @@ end



let process_file (input_file, location, syntax, std_out) =
let process_file (input_file, location, syntax, std_out, buffer_size, pool_size) =
let reason, extension = match syntax with
| `OCaml -> (false, ".ml")
| `Reason -> (true, ".re")
Expand Down Expand Up @@ -816,4 +867,4 @@ let process_file (input_file, location, syntax, std_out) =
(* |> Transform.empty_lines *)
|> Transform.coalesce
|> Transform.trim
|> Generate.generate ~reason location (output_string output_channel)
|> Generate.generate ~reason ~buffer_size ~pool_size location (output_string output_channel)
16 changes: 14 additions & 2 deletions src/eml/main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@

module Command_line :
sig
val parse : unit -> (string * string * [ `OCaml | `Reason ] * bool) list
val parse : unit -> (string * string * [ `OCaml | `Reason ] * bool * int * int) list
end =
struct
let usage = {|Usage:
Expand All @@ -27,6 +27,12 @@ struct
let std_out =
ref false

let buffer_size =
ref 4096

let pool_size =
ref 1

let options = Arg.align [
"--workspace",
Arg.Set_string workspace_path,
Expand All @@ -37,6 +43,12 @@ struct
"--stdout",
Arg.Set std_out,
" Print to STDOUT";
"--buffer-size",
Arg.Set_int buffer_size,
" Size of buffers for generated templates in bytes. 4096 by default";
"--pool-size",
Arg.Set_int pool_size,
" Amount of precreated buffers. 1 by default"
]

let set_file file =
Expand Down Expand Up @@ -77,7 +89,7 @@ struct
| ".re" -> `Reason
| _ -> `OCaml
in
file, Filename.concat prefix file, syntax, !std_out)
file, Filename.concat prefix file, syntax, !std_out, !buffer_size, !pool_size)
end

let () =
Expand Down
Loading