From 93549e9d79e286ed07c8ece7d99d9b1445d63a8b Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Mon, 22 Sep 2025 18:33:28 +1000 Subject: [PATCH] Remove most backtracking from lockdir parser To parse both portable and non-portable lockdirs with mostly the same code, the parser would attempt to parse fields with the non-portable lockdir syntax and fall back to the portable syntax should parsing fail. This led to the generation of parse errors when the first attempt at parsing a field would fail, and even though these errors are discarded, generating them took a noticeable amount of time. This changes the parsing logic to only attempt to parse fields in a single syntax, determined by the presence of the `solved_for_platforms` field in the lockdir metadata file. This field is present precisely when a lockdir is portable. Signed-off-by: Stephen Sherratt --- src/dune_pkg/lock_dir.ml | 74 ++++++++++++++++++++++----------------- src/dune_pkg/lock_dir.mli | 5 --- 2 files changed, 41 insertions(+), 38 deletions(-) diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index a70120e5efd..2151615a043 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -375,13 +375,15 @@ module Build_command = struct ] ;; - let decode_fields_backwards_compatible = + let decode_fields ~portable_lock_dir = let open Decoder in let parse_action = - (let+ action = Action.decode_pkg in - Conditional_choice_or_all_platforms.Choice - (Conditional_choice.singleton_all_platforms (Action action))) - <|> Conditional_choice_or_all_platforms.decode decode_portable + if portable_lock_dir + then Conditional_choice_or_all_platforms.decode decode_portable + else + let+ action = Action.decode_pkg in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms (Action action)) in fields_mutually_exclusive ~default:None @@ -617,38 +619,40 @@ module Pkg = struct let enabled_on_platforms = "enabled_on_platforms" end - let decode = + let decode ~portable_lock_dir = let open Decoder in - let parse_install_command_backwards_compatible = - (let+ action = Action.decode_pkg in - Conditional_choice_or_all_platforms.Choice - (Conditional_choice.singleton_all_platforms action)) - <|> Conditional_choice_or_all_platforms.decode Action.decode_pkg + let parse_install_command = + if portable_lock_dir + then Conditional_choice_or_all_platforms.decode Action.decode_pkg + else + let+ action = Action.decode_pkg in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms action) in - let parse_depends_backwards_compatible = - (let+ depends = repeat Dependency.decode in - Conditional_choice_or_all_platforms.Choice - (Conditional_choice.singleton_all_platforms depends)) - <|> Conditional_choice_or_all_platforms.decode (enter @@ repeat Dependency.decode) + let parse_depends = + if portable_lock_dir + then Conditional_choice_or_all_platforms.decode (enter @@ repeat Dependency.decode) + else + let+ depends = repeat Dependency.decode in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms depends) in - let parse_depexts_backwards_compatible = - (let+ external_package_names = repeat string in - [ { Depexts.external_package_names; enabled_if = `Always } ]) - <|> repeat Depexts.decode + let parse_depexts = + if portable_lock_dir + then repeat Depexts.decode + else + let+ external_package_names = repeat string in + [ { Depexts.external_package_names; enabled_if = `Always } ] in let empty_choice = Conditional_choice_or_all_platforms.Choice [] in enter @@ fields @@ let+ version = field Fields.version Package_version.decode and+ install_command = - field - ~default:empty_choice - Fields.install - parse_install_command_backwards_compatible - and+ build_command = Build_command.decode_fields_backwards_compatible - and+ depends = - field ~default:empty_choice Fields.depends parse_depends_backwards_compatible - and+ depexts = field ~default:[] Fields.depexts parse_depexts_backwards_compatible + field ~default:empty_choice Fields.install parse_install_command + and+ build_command = Build_command.decode_fields ~portable_lock_dir + and+ depends = field ~default:empty_choice Fields.depends parse_depends + and+ depexts = field ~default:[] Fields.depexts parse_depexts and+ source = field_o Fields.source Source.decode and+ dev = field_b Fields.dev and+ avoid = field_b Fields.avoid @@ -1198,10 +1202,7 @@ let decode_metadata = ~default:Solver_stats.Expanded_variable_bindings.empty Solver_stats.Expanded_variable_bindings.decode and+ solved_for_platforms = - field - "solved_for_platforms" - ~default:(Loc.none, []) - (located (repeat (enter Solver_env.decode))) + field_o "solved_for_platforms" (located (repeat (enter Solver_env.decode))) in ( ocaml , dependency_hash @@ -1464,6 +1465,7 @@ struct ;; let load_pkg + ~portable_lock_dir ~version ~lock_dir_path ~solved_for_platforms @@ -1482,7 +1484,7 @@ struct let parser = let env = Pform.Env.pkg Dune_lang.Pkg.syntax version in let decode = - Syntax.set Dune_lang.Pkg.syntax (Active version) Pkg.decode + Syntax.set Dune_lang.Pkg.syntax (Active version) (Pkg.decode ~portable_lock_dir) |> Syntax.set Dune_lang.Stanza.syntax (Active Dune_lang.Stanza.latest_version) in String_with_vars.set_decoding_env env decode @@ -1572,6 +1574,11 @@ struct = load_metadata (Path.relative lock_dir_path metadata_filename) in + let portable_lock_dir, solved_for_platforms = + match solved_for_platforms with + | Some x -> true, x + | None -> false, (Loc.none, []) + in let+ packages = Io.readdir_with_kinds lock_dir_path >>| List.filter_map ~f:(fun (name, (kind : Unix.file_kind)) -> @@ -1584,6 +1591,7 @@ struct let _loc, solved_for_platforms = solved_for_platforms in let+ pkg = load_pkg + ~portable_lock_dir ~version ~lock_dir_path ~solved_for_platforms diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 9c9f78800a8..838d347b5d3 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -68,11 +68,6 @@ module Pkg : sig val equal : t -> t -> bool val hash : t -> int val to_dyn : t -> Dyn.t - - val decode - : (lock_dir:Path.t -> solved_for_platforms:Solver_env.t list -> Package_name.t -> t) - Decoder.t - val files_dir : Package_name.t -> Package_version.t option -> lock_dir:Path.t -> Path.t end