argInfo + implicit yield

Author: majocha

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<range, SynExpr * TType * Expr>
+      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

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<range, SynExpr * TType * Expr>
     }
 
     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

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) -> 

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<SynExpr, _>(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