Add various fast-paths in typechecking. (#10590)

  - Skip Typecore.type_unpacks if there are no first-class modules
  - Skip Rec_check if the recursive binding is a function
  - Skip computation of disambiguation warnings, if disabled
  - Make Includemod.pair_components tail recursive

Changes

@@ -157,6 +157,9 @@ Working version
 - #10542: Fix detection of immediate64 types through unboxed types.
   (Leo White, review by Stephen Dolan and Gabriel Scherer)
 
+- #10590: Some typechecker optimisations
+  (Stephen Dolan, review by Gabriel Scherer and Leo White)
+
 OCaml 4.13.0
 -------------
 

typing/includemod.ml

@@ -575,8 +575,8 @@ and signatures ~loc env ~mark subst sig1 sig2 =
               false
           | _ -> name2, true
         in
-        begin try
-          let (id1, item1, pos1) = FieldMap.find name2 comps1 in
+        begin match FieldMap.find name2 comps1 with
+        | (id1, item1, pos1) ->
           let new_subst =
             match item2 with
               Sig_type _ ->
@@ -591,7 +591,7 @@ and signatures ~loc env ~mark subst sig1 sig2 =
           in
           pair_components new_subst
             ((item1, item2, pos1) :: paired) unpaired rem
-        with Not_found ->
+        | exception Not_found ->
           let unpaired =
             if report then
               item2 :: unpaired

typing/rec_check.ml

@@ -1202,17 +1202,20 @@ and is_destructuring_pattern : type k . k general_pattern -> bool =
         is_destructuring_pattern l || is_destructuring_pattern r
 
 let is_valid_recursive_expression idlist expr =
-  let ty = expression expr Return in
-  match Env.unguarded ty idlist, Env.dependent ty idlist,
-        classify_expression expr with
-  | _ :: _, _, _ (* The expression inspects rec-bound variables *)
-  | [], _ :: _, Dynamic -> (* The expression depends on rec-bound variables
-                              and its size is unknown *)
-      false
-  | [], _, Static (* The expression has known size *)
-  | [], [], Dynamic -> (* The expression has unknown size,
-                          but does not depend on rec-bound variables *)
-      true
+  match expr.exp_desc with
+  | Texp_function _ ->
+     (* Fast path: functions can never have invalid recursive references *)
+     true
+  | _ ->
+     match classify_expression expr with
+     | Static ->
+        (* The expression has known size *)
+        let ty = expression expr Return in
+        Env.unguarded ty idlist = []
+     | Dynamic ->
+        (* The expression has unknown size *)
+        let ty = expression expr Return in
+        Env.unguarded ty idlist = [] && Env.dependent ty idlist = []
 
 (* A class declaration may contain let-bindings. If they are recursive,
    their validity will already be checked by [is_valid_recursive_expression]

typing/typecore.ml

@@ -952,14 +952,16 @@ end) = struct
 
   (* warn if there are several distinct candidates in scope *)
   let warn_if_ambiguous warn lid env lbl rest =
-    Printtyp.Conflicts.reset ();
-    let paths = ambiguous_types env lbl rest in
-    let expansion =
-      Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
-    if paths <> [] then
-      warn lid.loc
-        (Warnings.Ambiguous_name ([Longident.last lid.txt],
-                                  paths, false, expansion))
+    if Warnings.is_active (Ambiguous_name ([],[],false,"")) then begin
+      Printtyp.Conflicts.reset ();
+      let paths = ambiguous_types env lbl rest in
+      let expansion =
+        Format.asprintf "%t" Printtyp.Conflicts.print_explanations in
+      if paths <> [] then
+        warn lid.loc
+          (Warnings.Ambiguous_name ([Longident.last lid.txt],
+                                    paths, false, expansion))
+    end
 
   (* a non-principal type was used for disambiguation *)
   let warn_non_principal warn lid =
@@ -970,11 +972,13 @@ end) = struct
 
   (* we selected a name out of the lexical scope *)
   let warn_out_of_scope warn lid env tpath =
-    let path_s =
-      Printtyp.wrap_printing_env ~error:true env
-        (fun () -> Printtyp.string_of_path tpath) in
-    warn lid.loc
-      (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+    if Warnings.is_active (Name_out_of_scope ("",[],false)) then begin
+      let path_s =
+        Printtyp.wrap_printing_env ~error:true env
+          (fun () -> Printtyp.string_of_path tpath) in
+      warn lid.loc
+        (Warnings.Name_out_of_scope (path_s, [Longident.last lid.txt], false))
+    end
 
   (* warn if the selected name is not the last introduced in scope
      -- in these cases the resolution is different from pre-disambiguation OCaml
@@ -4755,6 +4759,7 @@ and type_statement ?explanation env sexp =
 
 and type_unpacks ?(in_function : (Location.t * type_expr) option)
     env (unpacks : to_unpack list) sbody expected_ty =
+  if unpacks = [] then type_expect ?in_function env sbody expected_ty else
   let ty = newvar() in
   (* remember original level *)
   let extended_env, tunpacks =