From 426355dd8c1a4271d19e826ab1537d6599ea1e09 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 7 Nov 2026 10:06:14 +0000 Subject: [PATCH 1/2] Read fields of a variable-free object without copying its type MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Why: Each `o["f"]` instantiated the whole type of `o`, and the .cmt file stored every copy, so reading each field of an object with n fields once cost O(n²): 800 fields allocated 77M words and took 0.87 s. They now allocate 6.5M words and take 0.06 s. When the identifier's type is generic and has no type variables, a copy would be identical, so the identifier keeps the type itself and only the field's type is instantiated. Looking up a field that the type has doesn't change it. Types with variables are still copied. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01Kbf3gK1dcjbe97yY1wRMgs Signed-off-by: Christoph Knittel --- changes/object-field-reads.polish.md | 1 + compiler/ml/typecore.ml | 54 +++++++++++++++---- ...ndefined_method_closed_object.res.expected | 12 +++++ .../undefined_method_closed_object.res | 4 ++ 4 files changed, 61 insertions(+), 10 deletions(-) create mode 100644 changes/object-field-reads.polish.md create mode 100644 tests/build_tests/super_errors/expected/undefined_method_closed_object.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/undefined_method_closed_object.res diff --git a/changes/object-field-reads.polish.md b/changes/object-field-reads.polish.md new file mode 100644 index 0000000000..2470c2484d --- /dev/null +++ b/changes/object-field-reads.polish.md @@ -0,0 +1 @@ +- Speed up reading many fields of a large object, and shrink the `.cmt` files of such modules. diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 2ae56d4446..8dab5b8f2d 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -2566,9 +2566,27 @@ let object_valid_fields env ty = Some (List.fold_left collect_fields [] fields) | _ -> None -let rec type_exp ?deprecated_context ~context ?recarg env sexp = +(* Whether [ty] is generic and has no variables, so that an instance of it + would be an identical copy. Generic types don't change, so the answer + for the last type asked about is kept: field reads of one object usually + come one after another, and each check traverses the whole type. *) +let last_closed_scheme_key = Request_local.new_key (fun () -> ref None) + +let is_closed_scheme ty = + let ty = repr ty in + let last = Domain.DLS.get last_closed_scheme_key in + match !last with + | Some (ty', closed) when ty' == ty -> closed + | _ -> + let closed = ty.level = generic_level && Ctype.free_variables ty = [] in + last := Some (ty, closed); + closed + +let rec type_exp ?deprecated_context ~context ?recarg ?share_closed_type env + sexp = (* We now delegate everything to type_expect *) - type_expect ?deprecated_context ~context ?recarg env sexp (newvar ()) + type_expect ?deprecated_context ~context ?recarg ?share_closed_type env sexp + (newvar ()) (* Typing of an expression with an expected type. This provide better error messages, and allows controlled @@ -2576,8 +2594,8 @@ let rec type_exp ?deprecated_context ~context ?recarg env sexp = In the principal case, [type_expected'] may be at generic_level. *) -and type_expect ~context ?deprecated_context ?recarg ?match_context env sexp - ty_expected = +and type_expect ~context ?deprecated_context ?recarg ?match_context + ?share_closed_type env sexp ty_expected = (* Special errors for braced identifiers passed to records *) let context = match sexp.pexp_desc with @@ -2588,8 +2606,8 @@ and type_expect ~context ?deprecated_context ?recarg ?match_context env sexp let previous_saved_types = Cmt_format.get_saved_types () in let exp = Builtin_attributes.warning_scope sexp.pexp_attributes (fun () -> - type_expect_ ?deprecated_context ~context ?recarg ?match_context env - sexp ty_expected) + type_expect_ ?deprecated_context ~context ?recarg ?match_context + ?share_closed_type env sexp ty_expected) in Cmt_format.set_saved_types (Cmt_format.Partial_expression exp :: previous_saved_types); @@ -2599,8 +2617,13 @@ and type_expect ~context ?deprecated_context ?recarg ?match_context env sexp a match, and says what that match stands for in the source: it decides the wording of the match's diagnostics, which would otherwise speak of a switch. *) +(* [share_closed_type]: an identifier whose type has no variables gets that + type itself rather than a copy, and is not unified with [ty_expected]. + Only for callers that pass a fresh variable as [ty_expected] and don't + unify the type of the result. *) and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) - ?(match_context : [`Function] option) env sexp ty_expected = + ?(match_context : [`Function] option) ?(share_closed_type = false) env sexp + ty_expected = let loc = sexp.pexp_loc in (* Record the expression type before unifying it with the expected type *) let rue exp = @@ -2652,15 +2675,22 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) | true, Rejected, _ | false, Required, (Tvar _ | Tconstr _) -> raise (Error (loc, env, Inlined_record_escape)) | false, Required, _ -> () (* will fail later *)); - rue + let exp_type, share = + if share_closed_type && is_closed_scheme desc.val_type then + (desc.val_type, true) + else (instance env desc.val_type, false) + in + let exp = { exp_desc = Texp_ident (path, lid, desc); exp_loc = loc; exp_extra = []; - exp_type = instance env desc.val_type; + exp_type; exp_attributes = sexp.pexp_attributes; exp_env = env; } + in + if share then re exp else rue exp | Pexp_constant cst -> let cst = constant_or_raise env loc cst in rue @@ -3674,7 +3704,11 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) exp_env = env; } | Pexp_object_get (e, ({txt = met} as met_loc)) -> ( - let obj = type_exp ~context:None env e in + (* A copy of the object's type would be made and stored in the .cmt + file for each field read, which is quadratic for many reads of a + large object. Looking up a field that the type has doesn't change + the type, and the field's type is instantiated below. *) + let obj = type_exp ~context:None ~share_closed_type:true env e in try (* Lookup constrains an open object row to contain the field, without requiring or adding write capability. *) diff --git a/tests/build_tests/super_errors/expected/undefined_method_closed_object.res.expected b/tests/build_tests/super_errors/expected/undefined_method_closed_object.res.expected new file mode 100644 index 0000000000..deafc8b2d1 --- /dev/null +++ b/tests/build_tests/super_errors/expected/undefined_method_closed_object.res.expected @@ -0,0 +1,12 @@ + + We've found a bug for you! + /.../fixtures/undefined_method_closed_object.res:4:11 + + 2 │ + 3 │ let ok = o["existing"] + 1 + 4 │ let bad = o["missing"] + 5 │ + + This expression has type {"existing": int, "other": string} + It has no field missing +Hint: Did you mean existing? \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/undefined_method_closed_object.res b/tests/build_tests/super_errors/fixtures/undefined_method_closed_object.res new file mode 100644 index 0000000000..dbef33c89a --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/undefined_method_closed_object.res @@ -0,0 +1,4 @@ +let o = {"existing": 1, "other": "s"} + +let ok = o["existing"] + 1 +let bad = o["missing"] From 41ad3b035ef0b48e0db4292ea5efd2f7429d4a0a Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 7 Nov 2026 19:05:18 +0000 Subject: [PATCH 2/2] Type the object of a field read through its own identifier helper The benchmarks showed every expression allocating a little more (up to 0.17%), because the new optional argument of type_expect was captured by the closure it builds for each expression. Identifiers are now typed by type_ident, which the field read calls directly for a bare identifier, so type_expect is as before. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01Kbf3gK1dcjbe97yY1wRMgs Signed-off-by: Christoph Knittel --- compiler/ml/typecore.ml | 125 +++++++++++++++++++++------------------- 1 file changed, 67 insertions(+), 58 deletions(-) diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 8dab5b8f2d..de8553ec37 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -2582,11 +2582,52 @@ let is_closed_scheme ty = last := Some (ty, closed); closed -let rec type_exp ?deprecated_context ~context ?recarg ?share_closed_type env - sexp = +(* The identifier [lid] of [sexp], before it is unified with the expected + type. [share]: when the identifier's type is generic and has no variables, + the expression gets that type itself rather than an identical copy, for a + caller that won't unify it. *) +let type_ident ~context ~deprecated_context ~recarg ~share env sexp lid = + let path, desc = + try + Typetexp.find_value + ?deprecated_context: + (match deprecated_context with + | None -> Some Reference + | v -> v) + env lid.loc lid.txt + with + | Typetexp.Error (_, _, Unbound_value (Ldot (module_lid, "make"))) + when context = Some JsxComponent + -> + (* [