Skip to content

Commit

Permalink
Don't copy when resolving aliases in try_modtypes
Browse files Browse the repository at this point in the history
We were calling `expand_module_alias` to get the unstrengthened,
non-lazy type (potential deep copy), then checking whether it's an ident
and then strengthening it, thus throwing most of it away. This patch
avoids doing that by working directly on the lazy representation. This
is a significant win in some cases.

Note that ocaml-flambda#119 changes
this area significantly so I didn't want to refactor too much here.
  • Loading branch information
Roman Leshchinskiy committed Mar 9, 2023
1 parent aba6294 commit 8812b64
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 8 deletions.
24 changes: 16 additions & 8 deletions typing/includemod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -487,11 +487,12 @@ and try_modtypes ~in_eq ~loc env ~mark subst mty1 mty2 orig_shape =
| exception Env.Error (Env.Missing_module (_, _, path)) ->
Error Error.(Mt_core(Unbound_module_path path))
| p1 ->
begin match expand_module_alias ~strengthen:false env p1 with
| Error e -> Error (Error.Mt_core e)
| Ok mty1 ->
match strengthened_modtypes ~in_eq ~loc ~aliasable:true env ~mark
subst mty1 p1 mty2 orig_shape
begin match (Env.find_module_lazy p1 env).mdl_type with
| exception Not_found ->
Error (Error.Mt_core (Error.Unbound_module_path p1))
| mty1 ->
match strengthened_modtypes_lazy ~in_eq ~loc ~aliasable:true env
~mark subst mty1 p1 mty2 orig_shape
with
| Ok _ as x -> x
| Error reason -> Error (Error.After_alias_expansion reason)
Expand Down Expand Up @@ -627,15 +628,22 @@ and functor_param ~in_eq ~loc env ~mark subst param1 param2 =
| _, _ ->
Error (Error.Incompatible_params (param1, param2)), env, subst

and strengthened_modtypes ~in_eq ~loc ~aliasable env ~mark
and strengthened_modtypes_lazy ~in_eq ~loc ~aliasable env ~mark
subst mty1 path1 mty2 shape =
let open Subst.Lazy in
match mty1, mty2 with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
| MtyL_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
Ok (Tcoerce_none, shape)
| _, _ ->
let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
let mty1 = Mtype.strengthen_lazy ~aliasable env mty1 path1 in
let mty1 = Subst.Lazy.force_modtype mty1 in
modtypes ~in_eq ~loc env ~mark subst mty1 mty2 shape

and strengthened_modtypes ~in_eq ~loc ~aliasable env ~mark
subst mty1 path1 mty2 shape =
strengthened_modtypes_lazy ~in_eq ~loc ~aliasable env ~mark
subst (Subst.Lazy.of_modtype mty1) path1 mty2 shape

and strengthened_module_decl ~loc ~aliasable env ~mark
subst md1 path1 md2 shape =
match md1.md_type, md2.md_type with
Expand Down
1 change: 1 addition & 0 deletions typing/mtype.mli
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ val scrape_for_type_of:
val freshen: scope:int -> module_type -> module_type
(* Return an alpha-equivalent copy of the given module type
where bound identifiers are fresh. *)
val strengthen_lazy: aliasable:bool -> Env.t -> Subst.Lazy.modtype -> Path.t -> Subst.Lazy.modtype
val strengthen: aliasable:bool -> Env.t -> module_type -> Path.t -> module_type
(* Strengthen abstract type components relative to the
given path. *)
Expand Down

0 comments on commit 8812b64

Please sign in to comment.