diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index 7cbca970cc..1b71371b4e 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/src/Compiler/Checking/CheckBasics.fs @@ -243,11 +243,7 @@ type TcEnv = eLambdaArgInfos: ArgReprInfo list list // Do we lay down an implicit debug point? - eIsControlFlow: bool - - // In order to avoid checking implicit-yield expressions multiple times, we cache the resulting checked expressions. - // This avoids exponential behavior in the type checker when nesting implicit-yield expressions. - eCachedImplicitYieldExpressions : HashMultiMap + eIsControlFlow: bool } member tenv.DisplayEnv = tenv.eNameResEnv.DisplayEnv @@ -319,8 +315,6 @@ type TcFileState = diagnosticOptions: FSharpDiagnosticOptions - argInfoCache: ConcurrentDictionary<(string * range), ArgReprInfo> - // forward call TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv @@ -370,7 +364,6 @@ type TcFileState = conditionalDefines = conditionalDefines isInternalTestSpanStackReferring = isInternalTestSpanStackReferring diagnosticOptions = diagnosticOptions - argInfoCache = ConcurrentDictionary() TcPat = tcPat TcSimplePats = tcSimplePats TcSequenceExpressionEntry = tcSequenceExpressionEntry diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 179752c394..6c6537d116 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/src/Compiler/Checking/CheckBasics.fsi @@ -130,9 +130,6 @@ type TcEnv = eIsControlFlow: bool - // In order to avoid checking implicit-yield expressions multiple times, we cache the resulting checked expressions. - // This avoids exponential behavior in the type checker when nesting implicit-yield expressions. - eCachedImplicitYieldExpressions: HashMultiMap } member DisplayEnv: DisplayEnv @@ -269,11 +266,6 @@ type TcFileState = diagnosticOptions: FSharpDiagnosticOptions - /// A cache for ArgReprInfos which get created multiple times for the same values - /// Since they need to be later mutated with updates from signature files this should make sure - /// we're always dealing with the same instance and the updates don't get lost - argInfoCache: ConcurrentDictionary<(string * range), ArgReprInfo> - // forward call TcPat: WarnOnUpperFlag diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 07b40b6b11..5b034cd03c 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -5620,8 +5620,7 @@ let emptyTcEnv g = eCtorInfo = None eCallerMemberName = None eLambdaArgInfos = [] - eIsControlFlow = false - eCachedImplicitYieldExpressions = HashMultiMap(HashIdentity.Structural, useConcurrentDictionary = true) } + eIsControlFlow = false } let CreateInitialTcEnv(g, amap, scopem, assemblyName, ccus) = (emptyTcEnv g, ccus) ||> List.collectFold (fun env (ccu, autoOpens, internalsVisible) -> diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index c5228adecc..5e79f0b90c 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -955,8 +955,12 @@ let AdjustValSynInfoInSignature g ty (SynValInfo(argsData, retData) as sigMD) = | _ -> sigMD +let getArgInfoCache = + let options = Caches.CacheOptions.getDefault() |> Caches.CacheOptions.withNoEviction + let factory _ = new Caches.Cache<_, ArgReprInfo>(options, "argInfoCache") + WeakMap.getOrCreate factory -let TranslateTopArgSynInfo (cenv: cenv) isArg m tcAttributes (SynArgInfo(Attributes attrs, isOpt, nm)) = +let TranslateTopArgSynInfo cenv isArg m tcAttributes (SynArgInfo(Attributes attrs, isOpt, nm)) = // Synthesize an artificial "OptionalArgument" attribute for the parameter let optAttrs = if isOpt then @@ -977,20 +981,14 @@ let TranslateTopArgSynInfo (cenv: cenv) isArg m tcAttributes (SynArgInfo(Attribu // Call the attribute checking function let attribs = tcAttributes (optAttrs@attrs) - let key = nm |> Option.map (fun id -> id.idText, id.idRange) + let key = nm |> Option.map (fun id -> (id.idText, id.idRange)) + + let mkDefaultArgInfo _ : ArgReprInfo = { Attribs = attribs; Name = nm; OtherRange = None } let argInfo = - key - |> Option.map cenv.argInfoCache.TryGetValue - |> Option.bind (fun (found, info) -> - if found then - Some info - else None) - |> Option.defaultValue ({ Attribs = attribs; Name = nm; OtherRange = None }: ArgReprInfo) - - match key with - | Some k -> cenv.argInfoCache.[k] <- argInfo - | None -> () + match key with + | Some key -> (getArgInfoCache cenv).GetOrAdd(key, mkDefaultArgInfo) + | _ -> mkDefaultArgInfo () // Set freshly computed attribs in case they are different in the cache argInfo.Attribs <- attribs @@ -4051,6 +4049,13 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +// In order to avoid checking implicit-yield expressions multiple times, we cache the resulting checked expressions. +// This avoids exponential behavior in the type checker when nesting implicit-yield expressions. +let getImplicitYieldExpressionsCache = + let options = Caches.CacheOptions.getReferenceIdentity() |> Caches.CacheOptions.withNoEviction + let factory _ = new Caches.Cache(options, "implicitYieldExpressions") + WeakMap.getOrCreate factory + //------------------------------------------------------------------------- // Checking types and type constraints //------------------------------------------------------------------------- @@ -5503,19 +5508,12 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = let g = cenv.g - let cachedExpression = - env.eCachedImplicitYieldExpressions.FindAll synExpr.Range - |> List.tryPick (fun (se, ty, e) -> - if obj.ReferenceEquals(se, synExpr) then Some (ty, e) else None - ) - - match cachedExpression with - | Some (ty, expr) -> + match (getImplicitYieldExpressionsCache cenv).TryGetValue synExpr with + | true, (ty, expr) -> UnifyOverallType cenv env synExpr.Range overallTy ty expr, tpenv | _ -> - match synExpr with // A. @@ -6378,9 +6376,8 @@ and TcExprSequentialOrImplicitYield (cenv: cenv) overallTy env tpenv (sp, synExp | Expr.DebugPoint(_,e) -> e | _ -> expr1 - env.eCachedImplicitYieldExpressions.Add(synExpr1.Range, (synExpr1, expr1Ty, cachedExpr)) - try TcExpr cenv overallTy env tpenv otherExpr - finally env.eCachedImplicitYieldExpressions.Remove synExpr1.Range + (getImplicitYieldExpressionsCache cenv).AddOrUpdate(synExpr1, (expr1Ty, cachedExpr)) + TcExpr cenv overallTy env tpenv otherExpr and TcExprStaticOptimization (cenv: cenv) overallTy env tpenv (constraints, synExpr2, expr3, m) = let constraintsR, tpenv = List.mapFold (TcStaticOptimizationConstraint cenv env) tpenv constraints diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 52e404cea3..5aebc9f990 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -9,6 +9,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler +open FSharp.Compiler.Caches open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AttributeChecking @@ -36,6 +37,10 @@ open System.Collections.ObjectModel let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50 +let getFreeLocalsCache = + let options = CacheOptions.getReferenceIdentity() |> CacheOptions.withNoEviction + WeakMap.getOrCreate <| fun _ -> new Cache<_, _>(options, "freeLocalsCache") + let i_ldlen = [ I_ldlen; (AI_conv DT_I4) ] /// size of a function call @@ -2898,10 +2903,11 @@ and OptimizeLinearExpr cenv env expr contf = let (bindR, bindingInfo), env = OptimizeBinding cenv false env bind - OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) -> + OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. // Is it quadratic or quasi-quadratic? - if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr (CollectLocalsWithStackGuard()) bodyR).FreeLocals) (bindR, bindingInfo) then + let collect expr = (freeInExpr (CollectLocalsWithStackGuard()) expr).FreeLocals + if ValueIsUsedOrHasEffect cenv (fun () -> (getFreeLocalsCache cenv).GetOrAdd(bodyR, collect)) (bindR, bindingInfo) then // Eliminate let bindings on the way back up let exprR, adjust = TryEliminateLet cenv env bindR bodyR m exprR, diff --git a/src/Compiler/Utilities/Caches.fsi b/src/Compiler/Utilities/Caches.fsi index 9ecdcd2a79..c603af0f84 100644 --- a/src/Compiler/Utilities/Caches.fsi +++ b/src/Compiler/Utilities/Caches.fsi @@ -9,8 +9,8 @@ module internal CacheMetrics = /// Set FSHARP_OTEL_EXPORT environment variable to enable OpenTelemetry export to external collectors in tests. val Meter: Meter -[] /// A local listener that can be created for a specific Cache instance to get its metrics. For testing purposes only. +[] type internal CacheMetricsListener = member GetStats: unit -> Map member GetTotals: unit -> Map