From cfc790ec6471805e85f35f0e4c3465c4269b3dfd Mon Sep 17 00:00:00 2001 From: Sonja Heinze Date: Thu, 18 Jan 2024 16:48:15 +0100 Subject: [PATCH 1/2] Get rid of laziness in mpipeline Create Bg module backup First dirty prototype Second even dirtier prototype Some things work now! Clean up at least a little bit Very dirty refactor At least, this fixes the problem due to which the tests would hang instead of terminating: Before, the `single` mode would also try to draw the pipeline from cache. However, that cache was never inited in that mode (and shouln'd be in that mode). Now, workflow is a lot cleaner, but the implementation is still in prototype style. Fix 2 bugs With the flipped bit, the background domain would directely shut down. Using sleep instead of cpu_relax, leads to a race condition leading to an abtermal termination (only when running the query from within the dune tests, though!). --- src/analysis/locate.ml | 2 +- src/frontend/ocamlmerlin/new/new_merlin.ml | 18 +- .../ocamlmerlin/ocamlmerlin_server.ml | 40 +++-- src/frontend/ocamlmerlin/old/old_command.ml | 4 +- src/kernel/mconfig.ml | 19 ++- src/kernel/mconfig.mli | 4 +- src/kernel/mocaml.ml | 2 +- src/kernel/mpipeline.ml | 155 +++++++++++++----- src/kernel/mpipeline.mli | 4 +- src/kernel/mreader.ml | 4 +- 10 files changed, 170 insertions(+), 82 deletions(-) diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index 5f6e3a6543..5ff765beee 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -252,7 +252,7 @@ module Utils = struct let find_file_with_path ~config ?(with_fallback = false) file path = if File.name file = Misc.unitname Mconfig.(config.query.filename) then - Some Mconfig.(config.query.filename) + Mconfig.(config.query.filename) else let attempt_search src_suffix_pair = let fallback = diff --git a/src/frontend/ocamlmerlin/new/new_merlin.ml b/src/frontend/ocamlmerlin/new/new_merlin.ml index 78e13d9c34..3fdf5b6ffb 100644 --- a/src/frontend/ocamlmerlin/new/new_merlin.ml +++ b/src/frontend/ocamlmerlin/new/new_merlin.ml @@ -47,7 +47,7 @@ let commands_help () = print_endline doc) New_commands.all_commands -let run = +let run ~get_pipeline = let query_num = ref (-1) in function | [] -> @@ -110,12 +110,18 @@ let run = (); File_id.with_cache @@ fun () -> let source = Msource.make (Misc.string_of_file stdin) in - let pipeline = Mpipeline.make config source in + let file = config.Mconfig.query.filename in + let pipeline = + match get_pipeline file config source with + | None -> failwith "Why on earth is the pipeline domain down?" + | Some p -> p + in let json = let class_, message = Printexc.record_backtrace true; match - Mpipeline.with_pipeline pipeline @@ fun () -> + (* No with_pipeline needed here anymore: with_pipeline makes sure the typer and reader states are locked. We do that now on Pipeline.make instead*) + (* Mpipeline.with_pipeline pipeline @@ fun () -> *) command_action pipeline command_args with | result -> ("return", result) @@ -186,7 +192,7 @@ let with_wd ~wd ~old_wd f args = old_wd; f args -let run ~new_env wd args = +let run ~get_pipeline ~new_env wd args = begin match new_env with | Some env -> @@ -197,10 +203,10 @@ let run ~new_env wd args = let old_wd = Sys.getcwd () in let run args () = match wd with - | Some wd -> with_wd ~wd ~old_wd run args + | Some wd -> with_wd ~wd ~old_wd (run ~get_pipeline) args | None -> log ~title:"run" "No working directory specified (old wd: %S)" old_wd; - run args + run ~get_pipeline args in let `Log_file_path log_file, `Log_sections sections = Log_info.get () in Logger.with_log_file log_file ~sections @@ run args diff --git a/src/frontend/ocamlmerlin/ocamlmerlin_server.ml b/src/frontend/ocamlmerlin/ocamlmerlin_server.ml index 35ca8a3a64..70b3e42733 100644 --- a/src/frontend/ocamlmerlin/ocamlmerlin_server.ml +++ b/src/frontend/ocamlmerlin/ocamlmerlin_server.ml @@ -2,19 +2,20 @@ let merlin_timeout = try float_of_string (Sys.getenv "MERLIN_TIMEOUT") with _ -> 600.0 module Server = struct - let process_request { Os_ipc.wd; environ; argv; context = _ } = + let process_request ~get_pipeline { Os_ipc.wd; environ; argv; context = _ } = match Array.to_list argv with | "stop-server" :: _ -> raise Exit - | args -> New_merlin.run ~new_env:(Some environ) (Some wd) args + | args -> + New_merlin.run ~get_pipeline ~new_env:(Some environ) (Some wd) args - let process_client client = + let process_client ~get_pipeline client = let context = client.Os_ipc.context in Os_ipc.context_setup context; let close_with return_code = flush_all (); Os_ipc.context_close context ~return_code in - match process_request client with + match process_request ~get_pipeline client with | code -> close_with code | exception Exit -> close_with (-1); @@ -38,36 +39,39 @@ module Server = struct | Some _ as result -> result | None -> loop 1.0 - let rec loop merlinid server = + let rec loop merlinid server ~get_pipeline = match server_accept merlinid server with | None -> (* Timeout *) () | Some client -> let continue = - match process_client client with + match process_client ~get_pipeline client with | exception Exit -> false | () -> true in - if continue then loop merlinid server - - let start socket_path socket_fd = - match Os_ipc.server_setup socket_path socket_fd with - | None -> Logger.log ~section:"server" ~title:"cannot setup listener" "" - | Some server -> - (* If the client closes its connection, don't let it kill us with a SIGPIPE. *) - if Sys.unix then Sys.set_signal Sys.sigpipe Sys.Signal_ignore; - loop (File_id.get Sys.executable_name) server; - Os_ipc.server_close server + if continue then loop merlinid server ~get_pipeline end let main () = (* Setup env for extensions *) Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ())); match List.tl (Array.to_list Sys.argv) with - | "single" :: args -> exit (New_merlin.run ~new_env:None None args) + | "single" :: args -> + let get_pipeline _ a b = Some (Mpipeline.make a b) in + exit (New_merlin.run ~get_pipeline ~new_env:None None args) | "old-protocol" :: args -> Old_merlin.run args - | [ "server"; socket_path; socket_fd ] -> Server.start socket_path socket_fd + | [ "server"; socket_path; socket_fd ] -> begin + match Os_ipc.server_setup socket_path socket_fd with + | None -> Logger.log ~section:"server" ~title:"cannot setup listener" "" + | Some server -> + (* If the client closes its connection, don't let it kill us with a SIGPIPE. *) + if Sys.unix then Sys.set_signal Sys.sigpipe Sys.Signal_ignore; + ignore + @@ Mpipeline.make_with_cache + (Server.loop (File_id.get Sys.executable_name) server); + Os_ipc.server_close server + end | ("-help" | "--help" | "-h" | "server") :: _ -> Printf.eprintf "Usage: %s \n\ diff --git a/src/frontend/ocamlmerlin/old/old_command.ml b/src/frontend/ocamlmerlin/old/old_command.ml index 829729315b..3a1165757a 100644 --- a/src/frontend/ocamlmerlin/old/old_command.ml +++ b/src/frontend/ocamlmerlin/old/old_command.ml @@ -90,7 +90,7 @@ let configure (state : buffer) = | None -> config.Mconfig.query | Some path -> { config.Mconfig.query with - Mconfig.filename = Filename.basename path; + Mconfig.filename = Some (Filename.basename path); directory = Misc.canonicalize_filename (Filename.dirname path) }) } @@ -249,7 +249,7 @@ let dispatch (type a) (context : Context.t) (cmd : a command) : a = match cmd with | Query q -> let pipeline = make_pipeline config state.buffer in - Mpipeline.with_pipeline pipeline @@ fun () -> + (* Mpipeline.with_pipeline pipeline @@ fun () -> *) Query_commands.dispatch pipeline q | Sync (Checkout context) when state == Lazy.force default_state -> let buffer = checkout_buffer context in diff --git a/src/kernel/mconfig.ml b/src/kernel/mconfig.ml index 16dfa0ef18..10d02f1a1b 100644 --- a/src/kernel/mconfig.ml +++ b/src/kernel/mconfig.ml @@ -165,15 +165,18 @@ module Verbosity = struct end type query = - { filename : string; + { filename : string option; directory : string; printer_width : int; verbosity : Verbosity.t } +let query_filename q = match q.filename with +| None -> "*buffer*" +| Some filename -> filename let dump_query x = `Assoc - [ ("filename", `String x.filename); + [ ("filename", `String (query_filename x); ("directory", `String x.directory); ("printer_width", `Int x.printer_width); ("verbosity", Verbosity.to_json x.verbosity) @@ -683,7 +686,7 @@ let initial = cache_lifespan = 5 }; query = - { filename = "*buffer*"; + { filename = None; directory = Sys.getcwd (); verbosity = Verbosity.default; printer_width = 0 @@ -699,7 +702,7 @@ let global_flags = marg_path (fun path t -> let query = t.query in let path = Misc.canonicalize_filename path in - let filename = Filename.basename path in + let filename = Some (Filename.basename path) in let directory = Filename.dirname path in let t = { t with query = { query with filename; directory } } in Logger.with_log_file t.merlin.log_file ~sections:t.merlin.log_sections @@ -811,21 +814,23 @@ let cmt_path config = let global_modules ?(include_current = false) config = let modules = Misc.modules_in_path ~ext:".cmi" (build_path config) in + (* TODO: What's the deal here? Shouldn't it check for "*buffer*" instead of ""? In that case, match on the option *) if include_current then modules else - match config.query.filename with + match query_filename config.query with | "" -> modules | filename -> List.remove (Misc.unitname filename) modules (** {1 Accessors for other information} *) -let filename t = t.query.filename +let filename t = + query_filename t.query let unitname t = match t.merlin.unit_name with | Some name -> Misc.unitname name | None -> - let basename = Misc.unitname t.query.filename in + let basename = Misc.unitname @@ filename t in begin match t.merlin.wrapping_prefix with | Some prefix -> prefix ^ basename diff --git a/src/kernel/mconfig.mli b/src/kernel/mconfig.mli index 1b4430b4a6..137f1554d6 100644 --- a/src/kernel/mconfig.mli +++ b/src/kernel/mconfig.mli @@ -72,12 +72,14 @@ module Verbosity : sig end type query = - { filename : string; + { filename : string option; directory : string; printer_width : int; verbosity : Verbosity.t } +val query_filename : query -> string + (** {1 Main configuration} *) type t = { ocaml : ocaml; merlin : merlin; query : query } diff --git a/src/kernel/mocaml.ml b/src/kernel/mocaml.ml index 4f9fc0fa52..96247f0217 100644 --- a/src/kernel/mocaml.ml +++ b/src/kernel/mocaml.ml @@ -36,7 +36,7 @@ let setup_reader_config config = let open Clflags in let ocaml = config.ocaml in Env.set_unit_name (Mconfig.unitname config); - Location.input_name := config.query.filename; + Location.input_name := query_filename config.query; fast := ocaml.unsafe; classic := ocaml.classic; principal := ocaml.principal; diff --git a/src/kernel/mpipeline.ml b/src/kernel/mpipeline.ml index 2180675a74..78c1d422f8 100644 --- a/src/kernel/mpipeline.ml +++ b/src/kernel/mpipeline.ml @@ -5,22 +5,21 @@ let { Logger.log } = Logger.for_section "Pipeline" let time_shift = ref 0.0 let timed_lazy r x = - lazy - (let start = Misc.time_spent () in - let time_shift0 = !time_shift in - let update () = - let delta = Misc.time_spent () -. start in - let shift = !time_shift -. time_shift0 in - time_shift := time_shift0 +. delta; - r := !r +. delta -. shift - in - match Lazy.force x with - | x -> - update (); - x - | exception exn -> - update (); - Std.reraise exn) + let start = Misc.time_spent () in + let time_shift0 = !time_shift in + let update () = + let delta = Misc.time_spent () -. start in + let shift = !time_shift -. time_shift0 in + time_shift := time_shift0 +. delta; + r := !r +. delta -. shift + in + match Lazy.force x with + | x -> + update (); + x + | exception exn -> + update (); + Std.reraise exn module Cache = struct let cache = ref [] @@ -65,7 +64,7 @@ module Cache = struct end module Typer = struct - type t = { errors : exn list lazy_t; result : Mtyper.result } + type t = { errors : exn list; result : Mtyper.result } end module Ppx = struct @@ -82,10 +81,10 @@ type t = { config : Mconfig.t; state : Mocaml.typer_state; raw_source : Msource.t; - source : (Msource.t * Mreader.parsetree option) lazy_t; - reader : Reader.t lazy_t; - ppx : Ppx.t lazy_t; - typer : Typer.t lazy_t; + source : Msource.t * Mreader.parsetree option; + reader : Reader.t; + ppx : Ppx.t; + typer : Typer.t; pp_time : float ref; reader_time : float ref; ppx_time : float ref; @@ -99,21 +98,17 @@ type t = let raw_source t = t.raw_source let input_config t = t.config -let input_source t = fst (Lazy.force t.source) - -let with_pipeline t f = - Mocaml.with_state t.state @@ fun () -> - Mreader.with_ambient_reader t.config (input_source t) f +let input_source t = fst t.source let get_lexing_pos t pos = Msource.get_lexing_pos (input_source t) ~filename:(Mconfig.filename t.config) pos -let reader t = Lazy.force t.reader +let reader t = t.reader -let ppx t = Lazy.force t.ppx -let typer t = Lazy.force t.typer +let ppx t = t.ppx +let typer t = t.typer let reader_config t = (reader t).config let reader_parsetree t = (reader t).result.Mreader.parsetree @@ -130,8 +125,8 @@ let ppx_errors t = (ppx t).Ppx.errors let final_config t = (ppx t).Ppx.config -let typer_result t = (typer t).Typer.result -let typer_errors t = Lazy.force (typer t).Typer.errors +let typer_result t = t.typer.result +let typer_errors t = t.typer.errors module Reader_phase = struct type t = @@ -224,13 +219,14 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) ?(ppx_time = ref 0.0) ?(typer_time = ref 0.0) ?(error_time = ref 0.0) ?(ppx_cache_hit = ref false) ?(reader_cache_hit = ref false) ?(typer_cache_stats = ref Mtyper.Miss) ?for_completion config raw_source = + (* FIXME: Should state still be optional? *) let state = match state with | None -> Cache.get config | Some state -> state in let source = - timed_lazy pp_time + timed pp_time (lazy (match Mconfig.(config.ocaml.pp) with | None -> (raw_source, None) @@ -245,9 +241,9 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) | (`Interface _ | `Implementation _) as ast -> (raw_source, Some ast)))) in let reader = - timed_lazy reader_time + timed reader_time (lazy - (let (lazy ((_, pp_result) as source)) = source in + (let ((_, pp_result) as source) = source in let config = Mconfig.normalize config in Mocaml.setup_reader_config config; let cache_disabling = @@ -273,13 +269,10 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) { Reader.result; config; cache_version })) in let ppx = - timed_lazy ppx_time + timed ppx_time (lazy - (let (lazy - { Reader.result = { Mreader.parsetree; _ }; - config; - cache_version - }) = + (let { Reader.result = { Mreader.parsetree; _ }; config; cache_version } + = reader in let caught = ref [] in @@ -301,9 +294,9 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) { Ppx.config; parsetree; errors = !caught })) in let typer = - timed_lazy typer_time + timed typer_time (lazy - (let (lazy { Ppx.config; parsetree; _ }) = ppx in + (let { Ppx.config; parsetree; _ } = ppx in Mocaml.setup_typer_config config; let result = Mtyper.run config parsetree in let errors = timed_lazy error_time (lazy (Mtyper.get_errors result)) in @@ -327,7 +320,11 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) typer_cache_stats } -let make config source = process (Mconfig.normalize config) source +let make config source = + let state = Cache.get config in + Mocaml.with_state state @@ fun () -> + Mreader.with_ambient_reader config source @@ fun () -> + process (Mconfig.normalize config) source let for_completion position { config; @@ -373,3 +370,75 @@ let cache_information t = ("cmt", cmt); ("cmi", cmi) ] + +module With_cache = struct + (* Info shared from background domain to main domain *) + type nonrec cache = { pipeline : t; file : string } + + (* Info shared from main domain to background domain *) + type input = { config : Mconfig.t; source : Msource.t; file : string } + + let cache : cache option Atomic.t = Atomic.make None + let input : input option Atomic.t = Atomic.make None + let shut_down : bool Atomic.t = Atomic.make false + let domain_is_up : bool Atomic.t = Atomic.make false + + let trigger_pipeline file config source = + Atomic.set input (Some { config; source; file }) + + let check_and_invalidate filename = + match Atomic.get cache with + | None -> () + | Some { file; _ } -> + if String.equal file filename then () else Atomic.set cache None + + (* TODO: Suspend when accesing pipeline content, not here. *) + let get_pipeline file config source = + match file with + | Some file -> + check_and_invalidate file; + trigger_pipeline file config source; + let rec loop () = + match Atomic.get cache with + | Some { pipeline; file = _ } -> Some pipeline + | None -> + if not (Atomic.get domain_is_up) then None + else begin + Domain.cpu_relax (); + loop () + end + in + loop () + | None -> Some (make config source) + + let bg_domain_main () = + let rec loop () = + if Atomic.get shut_down then () + else + match Atomic.get input with + | None -> + Domain.cpu_relax (); + loop () + | Some { config; source; file } -> + let new_pipeline = make config source in + Atomic.set cache (Some { pipeline = new_pipeline; file }); + Atomic.set input None; + loop () + in + loop () + + let init () = + let d = Domain.spawn bg_domain_main in + Atomic.set domain_is_up true; + d + + let shutdown t = + Atomic.set shut_down true; + Domain.join t; + Atomic.set domain_is_up false +end + +let make_with_cache loop = + let d = With_cache.init () in + loop ~get_pipeline:With_cache.get_pipeline; + With_cache.shutdown d diff --git a/src/kernel/mpipeline.mli b/src/kernel/mpipeline.mli index f6f1d21df6..e71fdcb333 100644 --- a/src/kernel/mpipeline.mli +++ b/src/kernel/mpipeline.mli @@ -1,6 +1,6 @@ type t val make : Mconfig.t -> Msource.t -> t -val with_pipeline : t -> (unit -> 'a) -> 'a + val for_completion : Msource.position -> t -> t val raw_source : t -> Msource.t @@ -27,3 +27,5 @@ val typer_errors : t -> exn list val timing_information : t -> (string * float) list val cache_information : t -> Std.json + +val make_with_cache : (get_pipeline: (string option -> Mconfig.t -> Msource.t -> t option) -> unit) -> unit diff --git a/src/kernel/mreader.ml b/src/kernel/mreader.ml index bec0e36a7c..ea041c80c6 100644 --- a/src/kernel/mreader.ml +++ b/src/kernel/mreader.ml @@ -18,7 +18,7 @@ type result = let normal_parse ?for_completion config source = let kind = - let filename = Mconfig.(config.query.filename) in + let filename = Mconfig.(query_filename config.query) in let extension = match String.rindex filename '.' with | exception Not_found -> "" @@ -84,7 +84,7 @@ let get_reader config = match assocsuffixes with | [] -> [] | (suffix, reader) :: t -> - if Filename.check_suffix Mconfig.(config.query.filename) suffix then + if Filename.check_suffix Mconfig.(query_filename config.query) suffix then [ reader ] else find_reader t in From a6758ba2bad50481f4488de701081459254f7b07 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 11 Dec 2024 17:02:14 +0100 Subject: [PATCH 2/2] Fix issue after cherry pick --- src/analysis/index_occurrences.ml | 2 +- src/analysis/locate.ml | 2 +- src/analysis/occurrences.ml | 4 ++-- src/kernel/mconfig.ml | 12 ++++++------ src/kernel/mpipeline.ml | 7 +++---- 5 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/analysis/index_occurrences.ml b/src/analysis/index_occurrences.ml index 0f5b008603..2724eebff8 100644 --- a/src/analysis/index_occurrences.ml +++ b/src/analysis/index_occurrences.ml @@ -87,7 +87,7 @@ let items ~index ~stamp (config : Mconfig.t) items = None end) in let current_buffer_path = - Filename.concat config.query.directory config.query.filename + Filename.concat config.query.directory (Mconfig.query_filename config.query) in let reduce_for_uid = Shape_reduce.reduce_for_uid in let iterator = iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid in diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index 5ff765beee..44d4e051bb 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -251,7 +251,7 @@ module Utils = struct List.dedup_adjacent files ~cmp:String.compare let find_file_with_path ~config ?(with_fallback = false) file path = - if File.name file = Misc.unitname Mconfig.(config.query.filename) then + if File.name file = Misc.unitname Mconfig.(query_filename config.query) then Mconfig.(config.query.filename) else let attempt_search src_suffix_pair = diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index 78dcc2d5c8..5286d49020 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -175,7 +175,7 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = (None, `Buffer) in let current_buffer_path = - Filename.concat config.query.directory config.query.filename + Filename.concat config.query.directory (Mconfig.query_filename config.query) in match def with | Some (def_uid, def_loc) -> @@ -208,7 +208,7 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = match config.merlin.source_root with | Some root -> (Filename.concat root file, current_buffer_path) - | None -> (file, config.query.filename) + | None -> (file, Mconfig.query_filename config.query) in let file = Misc.canonicalize_filename file in let buf = Misc.canonicalize_filename buf in diff --git a/src/kernel/mconfig.ml b/src/kernel/mconfig.ml index 10d02f1a1b..bd40674880 100644 --- a/src/kernel/mconfig.ml +++ b/src/kernel/mconfig.ml @@ -171,12 +171,13 @@ type query = verbosity : Verbosity.t } -let query_filename q = match q.filename with -| None -> "*buffer*" -| Some filename -> filename +let query_filename q = + match q.filename with + | None -> "*buffer*" + | Some filename -> filename let dump_query x = `Assoc - [ ("filename", `String (query_filename x); + [ ("filename", `String (query_filename x)); ("directory", `String x.directory); ("printer_width", `Int x.printer_width); ("verbosity", Verbosity.to_json x.verbosity) @@ -823,8 +824,7 @@ let global_modules ?(include_current = false) config = (** {1 Accessors for other information} *) -let filename t = - query_filename t.query +let filename t = query_filename t.query let unitname t = match t.merlin.unit_name with diff --git a/src/kernel/mpipeline.ml b/src/kernel/mpipeline.ml index 78c1d422f8..e55ec5bb8e 100644 --- a/src/kernel/mpipeline.ml +++ b/src/kernel/mpipeline.ml @@ -4,7 +4,7 @@ let { Logger.log } = Logger.for_section "Pipeline" let time_shift = ref 0.0 -let timed_lazy r x = +let timed r x = let start = Misc.time_spent () in let time_shift0 = !time_shift in let update () = @@ -108,7 +108,6 @@ let get_lexing_pos t pos = let reader t = t.reader let ppx t = t.ppx -let typer t = t.typer let reader_config t = (reader t).config let reader_parsetree t = (reader t).result.Mreader.parsetree @@ -234,7 +233,7 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) let source = Msource.text raw_source in match Pparse.apply_pp ~workdir - ~filename:Mconfig.(config.query.filename) + ~filename:Mconfig.(query_filename config.query) ~source ~pp:workval with | `Source source -> (Msource.make source, None) @@ -299,7 +298,7 @@ let process ?state ?(pp_time = ref 0.0) ?(reader_time = ref 0.0) (let { Ppx.config; parsetree; _ } = ppx in Mocaml.setup_typer_config config; let result = Mtyper.run config parsetree in - let errors = timed_lazy error_time (lazy (Mtyper.get_errors result)) in + let errors = timed error_time (lazy (Mtyper.get_errors result)) in typer_cache_stats := Mtyper.get_cache_stat result; { Typer.errors; result })) in