Speed up record inclusion check.

Speed up record inclusion check.
Fixes #6284

Record inclusion check (between implementation and interface) is quadratic.

Example:
```res
module M : {
  type t<'a, 'b, 'c> = {x:list<('a, 'b)>, y:int, z:int}
} = {
  type t<'a, 'b, 'c> = {x:list<('a, 'c)>, y:int, z:int}
}
```

The algorithm tries to instantiate type parameters. It only reports an error if there is an inconsistency. This requires solving type equations involving many types at once.

To improve error message, the first problematic field is reported. So the type equations are checked again and again with size 1, 2, ...n where n is the number of fields. (Plus the type parameters).

This is quadratic and is problematic for types of ~1K elements.

This PR provides a fast path which just checks if there is an error, without blaming a specific field.
The fast path is linear.
Only if an error is detected, the quadratic path is take to blame precisely which field is involved.

Author: cristianoc

CHANGELOG.md

@@ -25,7 +25,7 @@
 
 - Fix issue where uncurried type internals leak in type error. https://github.com/rescript-lang/rescript-compiler/pull/6264
 - Improve error messages for untagged variant definitions https://github.com/rescript-lang/rescript-compiler/pull/6290
-
+- Fix type checking performance issue for large records. https://github.com/rescript-lang/rescript-compiler/issues/6284
 
 # 11.0.0-beta.1
 

jscomp/ml/includecore.ml

@@ -237,6 +237,35 @@ and compare_variants ~loc env params1 params2 n
       end
 
 
+and compare_records_fast ~loc env params1 params2 n
+    (labels1 : Types.label_declaration list)
+    (labels2 : Types.label_declaration list) =
+  match labels1, labels2 with
+    [], [] ->
+      Ctype.equal env true params1 params2
+  | [], _::_ -> false
+  | _::_, [] -> false
+  | ld1::rem1, ld2::rem2 ->
+      if Ident.name ld1.ld_id <> Ident.name ld2.ld_id
+      then false
+      else if ld1.ld_mutable <> ld2.ld_mutable then false else begin
+        Builtin_attributes.check_deprecated_mutable_inclusion
+          ~def:ld1.ld_loc
+          ~use:ld2.ld_loc
+          loc
+          ld1.ld_attributes ld2.ld_attributes
+          (Ident.name ld1.ld_id);
+        let field_mismatch = !Builtin_attributes.check_bs_attributes_inclusion  
+          ld1.ld_attributes ld2.ld_attributes
+          (Ident.name ld1.ld_id) in 
+        match field_mismatch with
+        | Some _ -> false
+        | None ->
+          compare_records_fast ~loc env
+            (ld1.ld_type::params1) (ld2.ld_type::params2)
+            (n+1)
+            rem1 rem2
+      end  
 and compare_records ~loc env params1 params2 n
     (labels1 : Types.label_declaration list)
     (labels2 : Types.label_declaration list) =
@@ -324,8 +353,9 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 =
         if equality then mark cstrs2 Env.Positive (Ident.name id) decl2;
         compare_variants ~loc env decl1.type_params decl2.type_params 1 cstrs1 cstrs2
     | (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
-        let err = compare_records ~loc env decl1.type_params decl2.type_params
-            1 labels1 labels2 in
+        let ok = compare_records_fast ~loc env decl1.type_params decl2.type_params 1 labels1 labels2 in
+        let err = if ok then [] else
+          compare_records ~loc env decl1.type_params decl2.type_params 1 labels1 labels2 in
         if err <> [] || rep1 = rep2 then err else
         [Record_representation (rep1, rep2)]
     | (Type_open, Type_open) -> []