package merlin-lib
Merlin's libraries
Install
Dune Dependency
Authors
Maintainers
Sources
merlin-5.5-503.tbz
sha256=67da3b34f2fea07678267309f61da4a2c6f08298de0dc59655b8d30fd8269af1
sha512=1fb3b5180d36aa82b82a319e15b743b802b6888f0dc67645baafdb4e18dfc23a7b90064ec9bc42f7424061cf8cde7f8839178d8a8537bf4596759f3ff4891873
doc/src/merlin-lib.kernel/mpipeline.ml.html
Source file mpipeline.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
open Std 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) module Cache = struct let cache = ref [] (* Values from configuration that are used as a key for the cache. These values should: - allow to maximize reuse; associating a single typechecker instance to a filename and directory is natural, but keying also based on verbosity makes no sense - prevent reuse in different environments (if there is a change in loadpath, a new typechecker should be produced). It would be better to guarantee that the typechecker was well-behaved when the loadpath changes (so that we can reusing the same instance, and let the typechecker figure which part of its internal state should be invalidated). However we already had many bug related to that. There are subtle changes in the type checker behavior across the different versions of OCaml. It is simpler to create new instances upfront. *) let key config = Mconfig. ( config.query.filename, config.query.directory, config.ocaml, { config.merlin with log_file = None; log_sections = [] } ) let get config = let title = "pop_cache" in let key = key config in match List.assoc key !cache with | state -> cache := (key, state) :: List.remove_assoc key !cache; log ~title "found entry for this configuration"; state | exception Not_found -> log ~title "nothing cached for this configuration"; let state = Mocaml.new_state () in cache := (key, state) :: List.take_n 5 !cache; state end module Typer = struct type t = { errors : exn list lazy_t; result : Mtyper.result } end module Ppx = struct type t = { config : Mconfig.t; errors : exn list; parsetree : Mreader.parsetree } end module Reader = struct type t = { result : Mreader.result; config : Mconfig.t; cache_version : int option } end 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; pp_time : float ref; reader_time : float ref; ppx_time : float ref; typer_time : float ref; error_time : float ref; ppx_cache_hit : bool ref; reader_cache_hit : bool ref; typer_cache_stats : Mtyper.typer_cache_stats ref } 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 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 ppx t = Lazy.force t.ppx let typer t = Lazy.force t.typer let reader_config t = (reader t).config let reader_parsetree t = (reader t).result.Mreader.parsetree let reader_comments t = (reader t).result.Mreader.comments let reader_lexer_keywords t = (reader t).result.Mreader.lexer_keywords let reader_lexer_errors t = (reader t).result.Mreader.lexer_errors let reader_parser_errors t = (reader t).result.Mreader.parser_errors let reader_no_labels_for_completion t = (reader t).result.Mreader.no_labels_for_completion let ppx_parsetree t = (ppx t).Ppx.parsetree 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 module Reader_phase = struct type t = { source : Msource.t * Mreader.parsetree option; for_completion : Msource.position option; config : Mconfig.t } type output = { result : Mreader.result; cache_version : int } let f = let cache_version = ref 0 in fun { source; for_completion; config } -> let result = Mreader.parse ?for_completion config source in incr cache_version; { result; cache_version = !cache_version } let title = "Reader phase" module Fingerprint = struct type t = Msource.Digest.t let make { source = source, _; _ } = Ok (Msource.Digest.make source) let equal = Msource.Digest.equal end end module Reader_with_cache = Phase_cache.With_cache (Reader_phase) module Ppx_phase = struct type reader_cache = Off | Version of int type t = { parsetree : Mreader.parsetree; config : Mconfig.t; reader_cache : reader_cache } type output = Mreader.parsetree let f { parsetree; config; _ } = Mppx.rewrite parsetree config let title = "PPX phase" module Single_fingerprint = struct type t = { binary_id : File_id.t; args : string list; workdir : string } let make ~binary ~args ~workdir = let qualified_binary = Filename.concat workdir binary in match File_id.get_res qualified_binary with | Ok binary_id -> Ok { binary_id; args; workdir } | Error err -> Error err let equal { binary_id = b1; args = a1; workdir = w1 } { binary_id = b2; args = a2; workdir = w2 } = File_id.check b1 b2 && List.same ~f:String.equal a1 a2 && String.equal w1 w2 end module Fingerprint = struct type t = Single_fingerprint.t list * reader_cache let make { config; reader_cache; _ } = let rec all_fingerprints acc = function | [] -> acc | { Std.workdir; workval } :: tl -> ( match Std.String.split_on_char ~sep:' ' workval with | [] -> Error ("unhandled workval" ^ workval) | binary :: args -> Result.bind ~f:(fun fp -> all_fingerprints (Result.map ~f:(List.cons fp) acc) tl) (Single_fingerprint.make ~binary ~args ~workdir)) in Result.map (all_fingerprints (Ok []) config.ocaml.ppx) ~f:(fun l -> (l, reader_cache)) let equal_cache_version cv1 cv2 = match (cv1, cv2) with | Off, _ | _, Off -> false | Version v1, Version v2 -> Int.equal v1 v2 let equal (f1, rcv1) (f2, rcv2) = equal_cache_version rcv1 rcv2 && List.equal ~eq:Single_fingerprint.equal f1 f2 end end module Ppx_with_cache = Phase_cache.With_cache (Ppx_phase) 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 = let state = match state with | None -> Cache.get config | Some state -> state in let source = timed_lazy pp_time (lazy (match Mconfig.(config.ocaml.pp) with | None -> (raw_source, None) | Some { workdir; workval } -> ( let source = Msource.text raw_source in match Pparse.apply_pp ~workdir ~filename:Mconfig.(config.query.filename) ~source ~pp:workval with | `Source source -> (Msource.make source, None) | (`Interface _ | `Implementation _) as ast -> (raw_source, Some ast)))) in let reader = timed_lazy reader_time (lazy (let (lazy ((_, pp_result) as source)) = source in let config = Mconfig.normalize config in Mocaml.setup_reader_config config; let cache_disabling = match (config.merlin.use_ppx_cache, pp_result) with | false, _ -> Some "configuration" | true, Some _ -> (* The cache could be refined in the future to also act on the PP phase. For now, let's disable the whole cache when there's a PP. *) Some "source preprocessor usage" | true, None -> None in let { Reader_with_cache.output = { result; cache_version }; cache_was_hit } = Reader_with_cache.apply ~cache_disabling { source; for_completion; config } in reader_cache_hit := cache_was_hit; let cache_version = if Option.is_some cache_disabling then None else Some cache_version in { Reader.result; config; cache_version })) in let ppx = timed_lazy ppx_time (lazy (let (lazy { Reader.result = { Mreader.parsetree; _ }; config; cache_version }) = reader in let caught = ref [] in Msupport.catch_errors Mconfig.(config.ocaml.warnings) caught @@ fun () -> (* Currently the cache is invalidated even for source changes that don't change the parsetree. To avoid that, we'd have to digest the parsetree in the cache. *) let cache_disabling, reader_cache = match cache_version with | Some v -> (None, Ppx_phase.Version v) | None -> (Some "reader cache is disabled", Off) in let { Ppx_with_cache.output = parsetree; cache_was_hit } = Ppx_with_cache.apply ~cache_disabling { parsetree; config; reader_cache } in ppx_cache_hit := cache_was_hit; { Ppx.config; parsetree; errors = !caught })) in let typer = timed_lazy typer_time (lazy (let (lazy { 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 typer_cache_stats := Mtyper.get_cache_stat result; { Typer.errors; result })) in { config; state; raw_source; source; reader; ppx; typer; pp_time; reader_time; ppx_time; typer_time; error_time; ppx_cache_hit; reader_cache_hit; typer_cache_stats } let make config source = process (Mconfig.normalize config) source let for_completion position { config; state; raw_source; pp_time; reader_time; ppx_time; typer_time; error_time; _ } = process config raw_source ~for_completion:position ~state ~pp_time ~reader_time ~ppx_time ~typer_time ~error_time let timing_information t = [ ("pp", !(t.pp_time)); ("reader", !(t.reader_time)); ("ppx", !(t.ppx_time)); ("typer", !(t.typer_time)); ("error", !(t.error_time)) ] let cache_information t = let typer = match !(t.typer_cache_stats) with | Miss -> `String "miss" | Hit { reused; typed } -> `Assoc [ ("reused", `Int reused); ("typed", `Int typed) ] in let fmt_hit_miss h m = `Assoc [ ("hit", `Int h); ("miss", `Int m) ] in let cmt_stat = Cmt_cache.get_cache_stats () in let cmt = fmt_hit_miss cmt_stat.hit cmt_stat.miss in let cmi_stat = Cmi_cache.get_cache_stats () in let cmi = fmt_hit_miss cmi_stat.hit cmi_stat.miss in Cmt_cache.clear_cache_stats (); Cmi_cache.clear_cache_stats (); let fmt_bool hit = `String (if hit then "hit" else "miss") in `Assoc [ ("reader_phase", fmt_bool !(t.reader_cache_hit)); ("ppx_phase", fmt_bool !(t.ppx_cache_hit)); ("typer", typer); ("cmt", cmt); ("cmi", cmi) ]
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>