Add various fast-paths in typechecking.

  - Skip Builtin_attributes.warning_scope if there are no attributes
  - 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

parsing/builtin_attributes.ml

@@ -243,6 +243,10 @@ let warning_scope ?ppwarning attrs f =
     Warnings.restore prev;
     raise exn
 
+let warning_scope ?ppwarning attrs f =
+  match attrs with
+  | [] -> f ()
+  | _ -> warning_scope ?ppwarning attrs f
 
 let warn_on_literal_pattern =
   List.exists

typing/rec_check.ml

@@ -106,7 +106,7 @@ exception Illegal_expr
 
 (** {1 Static or dynamic size} *)
 
-type sd = Static | Dynamic
+type sd = Static | Dynamic | Static_Delay
 
 let is_ref : Types.value_description -> bool = function
   | { Types.val_kind =
@@ -189,12 +189,14 @@ let classify_expression : Typedtree.expression -> sd =
     | Texp_setinstvar _
     | Texp_pack _
     | Texp_object _
-    | Texp_function _
     | Texp_lazy _
     | Texp_unreachable
     | Texp_extension_constructor _ ->
         Static
 
+    | Texp_function _ ->
+        Static_Delay
+
     | Texp_match _
     | Texp_ifthenelse _
     | Texp_send _
@@ -1202,17 +1204,16 @@ 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 classify_expression expr with
+  | Static_Delay -> true
+  | 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 =