[MicroPerf] Avoid per-call closure allocation in type-hierarchy traversal

src/Compiler/Checking/TypeHierarchy.fs

@@ -2,6 +2,7 @@
 
 module internal FSharp.Compiler.TypeHierarchy
 
+open Internal.Utilities.Library
 open Internal.Utilities.Library.Extras
 open FSharp.Compiler.Text
 open FSharp.Compiler.AbstractIL.IL
@@ -239,7 +240,7 @@ let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor
             | _ -> false
 
         // Do not visit the same type twice. Could only be doing this if we've seen this tycon
-        if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else
+        if seenThisTycon && ListInline.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else
 
         // Do not visit the same tycon twice, e.g. I<int> and I<string>, collect I<int> only, unless directed to allow this
         if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else
@@ -253,10 +254,11 @@ let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor
                 state
 
         if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (RichText.mkText (showType ty))), m)); (visitedTycon, visited, acc)) else
+        // Local 'loop' is passed as a lambda, not 'loop (ndeep+1)': InlineIfLambda then inlines it instead of allocating it as a closure.
         let visitedTycon, visited, acc =
             if isInterfaceTy g ty then
-                List.foldBack
-                   (loop (ndeep+1))
+                ListInline.foldBack
+                   (fun ity st -> loop (ndeep+1) ity st)
                    (GetImmediateInterfacesOfType skipUnref g amap m ty)
                       (loop ndeep g.obj_ty_noNulls state)
             else
@@ -287,15 +289,15 @@ let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor
                 | _ ->
                     let state =
                         if followInterfaces then
-                            List.foldBack
-                              (loop (ndeep+1))
+                            ListInline.foldBack
+                              (fun ity st -> loop (ndeep+1) ity st)
                               (GetImmediateInterfacesOfType skipUnref g amap m ty)
                               state
                         else
                             state
                     let state =
                         Option.foldBack
-                          (loop (ndeep+1))
+                          (fun sty st -> loop (ndeep+1) sty st)
                           (GetSuperTypeOfType g amap m ty)
                           state
                     state

src/Compiler/Utilities/illib.fs

@@ -436,6 +436,36 @@ module Option =
 module internal ValueTuple =
     let inline map1Of2 ([<InlineIfLambda>] f) struct (a1, a2) = struct (f a1, a2)
 
+module ListInline =
+    /// List.exists, but inline so the predicate is inlined (InlineIfLambda) rather than allocated as a closure.
+    let inline exists ([<InlineIfLambda>] predicate: 'T -> bool) (list: 'T list) =
+        let mutable rest = list
+        let mutable result = false
+
+        while not result && not rest.IsEmpty do
+            result <- predicate rest.Head
+            rest <- rest.Tail
+
+        result
+
+    /// List.foldBack, but inline so the folder is inlined (InlineIfLambda). Folds lengths up to 5 directly; longer lists use an array, staying stack-safe like List.foldBack.
+    let inline foldBack ([<InlineIfLambda>] folder: 'T -> 'State -> 'State) (list: 'T list) (state: 'State) =
+        match list with
+        | [] -> state
+        | [ h ] -> folder h state
+        | [ h1; h2 ] -> folder h1 (folder h2 state)
+        | [ h1; h2; h3 ] -> folder h1 (folder h2 (folder h3 state))
+        | [ h1; h2; h3; h4 ] -> folder h1 (folder h2 (folder h3 (folder h4 state)))
+        | [ h1; h2; h3; h4; h5 ] -> folder h1 (folder h2 (folder h3 (folder h4 (folder h5 state))))
+        | _ ->
+            let array = List.toArray list
+            let mutable state = state
+
+            for i = array.Length - 1 downto 0 do
+                state <- folder array[i] state
+
+            state
+
 module List =
 
     let sortWithOrder (c: IComparer<'T>) elements =

src/Compiler/Utilities/illib.fsi

@@ -152,6 +152,13 @@ module internal Option =
 
     val attempt: f: (unit -> 'T) -> 'T option
 
+module internal ListInline =
+    /// List.exists, but inline so the predicate is inlined (InlineIfLambda) rather than allocated as a closure.
+    val inline exists: [<InlineIfLambda>] predicate: ('T -> bool) -> list: 'T list -> bool
+
+    /// List.foldBack, but inline so the folder is inlined (InlineIfLambda). Folds lengths up to 5 directly; longer lists use an array, staying stack-safe like List.foldBack.
+    val inline foldBack: [<InlineIfLambda>] folder: ('T -> 'State -> 'State) -> list: 'T list -> state: 'State -> 'State
+
 module internal List =
 
     val sortWithOrder: c: IComparer<'T> -> elements: 'T list -> 'T list