[RFC FS-1043] Extension members visible to trait constraints

.gitignore

@@ -85,7 +85,8 @@ project.lock.json
 Backup/
 tests/fsharp/core/array/dont.run.peverify
 tests/fsharp/core/innerpoly/dont.run.peverify
-tests/fsharp/typecheck/sigs/neg94-pre.dll
+tests/fsharp/typecheck/sigs/*.dll
+tests/fsharp/typecheck/sigs/*.exe
 times
 /tests/fsharpqa/testenv/bin/System.ValueTuple.dll
 source_link.json

src/Compiler/Checking/AccessibilityLogic.fs

@@ -38,6 +38,8 @@ type AccessorDomain =
     /// An AccessorDomain which returns all items
     | AccessibleFromSomewhere 
 
+    interface ITraitAccessorDomain
+
     // Hashing and comparison is used for the memoization tables keyed by an accessor domain.
     // It is dependent on a TcGlobals because of the TyconRef in the data structure
     static member CustomGetHashCode(ad:AccessorDomain) = 

src/Compiler/Checking/AccessibilityLogic.fsi

@@ -31,6 +31,8 @@ type AccessorDomain =
     /// An AccessorDomain which returns all items
     | AccessibleFromSomewhere
 
+    interface ITraitAccessorDomain
+
     // Hashing and comparison is used for the memoization tables keyed by an accessor domain.
     // It is dependent on a TcGlobals because of the TyconRef in the data structure
     static member CustomEquals: g: TcGlobals * ad1: AccessorDomain * ad2: AccessorDomain -> bool

src/Compiler/Checking/CheckBasics.fs

@@ -249,6 +249,18 @@ type TcEnv =
 
     member tenv.AccessRights = tenv.eAccessRights
 
+    /// Makes this environment available in a form that can be stored into a trait during solving.
+    member tenv.TraitContext = Some (tenv :> ITraitContext)
+
+    interface ITraitContext with
+
+        member tenv.SelectExtensionMethods(traitInfo, m, infoReader) =
+            let infoReader = unbox<InfoReader>(infoReader)
+            SelectExtensionMethInfosForTrait(traitInfo, m, tenv.eNameResEnv, infoReader)
+            |> List.map (fun (supportTy, minfo) -> supportTy, (minfo :> ITraitExtensionMember))
+
+        member tenv.AccessRights = (tenv.eAccessRights :> ITraitAccessorDomain)
+
     override tenv.ToString() = "TcEnv(...)"
 
 /// Represents the compilation environment for typechecking a single file in an assembly.
@@ -337,7 +349,7 @@ type TcFileState =
 
         let niceNameGen = NiceNameGenerator()
         let infoReader = InfoReader(g, amap)
-        let instantiationGenerator m tpsorig = FreshenTypars g m tpsorig
+        let instantiationGenerator m tpsorig traitCtxt = FreshenTypars g traitCtxt m tpsorig
         let nameResolver = NameResolver(g, amap, infoReader, instantiationGenerator)
         { g = g
           amap = amap

src/Compiler/Checking/CheckBasics.fsi

@@ -134,6 +134,10 @@ type TcEnv =
 
     member AccessRights: AccessorDomain
 
+    member TraitContext: ITraitContext option
+
+    interface ITraitContext
+
 /// Represents the current environment of type variables that have implicit scope
 /// (i.e. are without explicit declaration).
 type UnscopedTyparEnv = UnscopedTyparEnv of NameMap<Typar>

src/Compiler/Checking/CheckComputationExpressions.fs

@@ -58,7 +58,7 @@ let (|JoinRelation|_|) cenv env (expr: SynExpr) =
 
     let isOpName opName vref s =
         (s = opName) &&
-        match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with
+        match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.TraitContext env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with
         | Result (_, Item.Value vref2, []) -> valRefEq cenv.g vref vref2
         | _ -> false
 

src/Compiler/Checking/CheckDeclarations.fs

@@ -833,8 +833,7 @@ module MutRecBindingChecking =
                         AddLocalTyconRefs true g cenv.amap tcref.Range [tcref] initialEnvForTycon
 
                 // Make fresh version of the class type for type checking the members and lets *
-                let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
-
+                let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv envForTycon.TraitContext tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
 
                 // The basic iteration over the declarations in a single type definition
                 let initialInnerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev)
@@ -2207,7 +2206,7 @@ module TcExceptionDeclarations =
           match reprIdOpt with 
           | Some longId ->
               let resolution =
-                  ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.NameEnv TypeNameResolutionInfo.Default longId 
+                  ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.TraitContext env.NameEnv TypeNameResolutionInfo.Default longId 
                   |> ForceRaise
               match resolution with
               | _, Item.ExnCase exnc, [] -> 
@@ -2723,7 +2722,7 @@ module EstablishTypeDefinitionCores =
         | None -> None
         | Some (tc, args, m) -> 
             let ad = envinner.AccessRights
-            match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified envinner.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.Yes with
+            match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified envinner.NameEnv ad envinner.TraitContext tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.Yes with
             | Result (_, tcrefBeforeStaticArguments) when 
                   tcrefBeforeStaticArguments.IsProvided && 
                   not tcrefBeforeStaticArguments.IsErased -> 
@@ -3185,7 +3184,7 @@ module EstablishTypeDefinitionCores =
                         let info = RecdFieldInfo(thisTyInst, thisTyconRef.MakeNestedRecdFieldRef fspec)
                         let nenv' = AddFakeNameToNameEnv fspec.LogicalName nenv (Item.RecdField info) 
                         // Name resolution gives better info for tooltips
-                        let item = Item.RecdField(FreshenRecdFieldRef cenv.nameResolver m (thisTyconRef.MakeNestedRecdFieldRef fspec))
+                        let item = Item.RecdField(FreshenRecdFieldRef cenv.nameResolver envinner.TraitContext m (thisTyconRef.MakeNestedRecdFieldRef fspec))
                         CallNameResolutionSink cenv.tcSink (fspec.Range, nenv, item, emptyTyparInst, ItemOccurence.Binding, ad)
                         // Environment is needed for completions
                         CallEnvSink cenv.tcSink (fspec.Range, nenv', ad)
@@ -3847,15 +3846,15 @@ module TcDeclarations =
 
             // This records a name resolution of the type at the location
             let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length
-            ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No 
+            ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad envForDecls.TraitContext longPath resInfo PermitDirectReferenceToGeneratedType.No 
                |> ignore
 
             mkLocalTyconRef tycon
 
           | _ ->
             let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length
             let _, tcref =
-                match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with
+                match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad envForDecls.TraitContext longPath resInfo PermitDirectReferenceToGeneratedType.No with
                 | Result res -> res
                 | res when inSig && List.isSingleton longPath ->
                     errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m))
@@ -5047,7 +5046,7 @@ let AddCcuToTcEnv (g, amap, scopem, env, assemblyName, ccu, autoOpens, internals
 
     (env, autoOpens) ||> List.collectFold (ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap ccu scopem)
 
-let emptyTcEnv g =
+let emptyTcEnv g : TcEnv =
     let cpath = compPathInternal // allow internal access initially
     { eNameResEnv = NameResolutionEnv.Empty g
       eUngeneralizableItems = []
@@ -5104,23 +5103,10 @@ let ApplyDefaults (cenv: cenv) g denvAtEnd m moduleContents extraAttribs =
     try
         let unsolved = FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd moduleContents extraAttribs
 
-        CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved
-
-        // The priority order comes from the order of declaration of the defaults in FSharp.Core.
-        for priority = 10 downto 0 do
-            unsolved |> List.iter (fun tp -> 
-                if not tp.IsSolved then 
-                    // Apply the first default. If we're defaulting one type variable to another then 
-                    // the defaults will be propagated to the new type variable. 
-                    ApplyTyparDefaultAtPriority denvAtEnd cenv.css priority tp)
+        CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved false
 
-        // OK, now apply defaults for any unsolved TyparStaticReq.HeadType 
-        unsolved |> List.iter (fun tp ->     
-            if not tp.IsSolved then 
-                if (tp.StaticReq <> TyparStaticReq.None) then
-                    ChooseTyparSolutionAndSolve cenv.css denvAtEnd tp)
-    with exn ->
-        errorRecovery exn m
+        ApplyDefaultsForUnsolved cenv.css denvAtEnd unsolved
+    with e -> errorRecovery e m
 
 let CheckValueRestriction denvAtEnd infoReader rootSigOpt implFileTypePriorToSig m = 
     if Option.isNone rootSigOpt then
@@ -5145,9 +5131,7 @@ let CheckValueRestriction denvAtEnd infoReader rootSigOpt implFileTypePriorToSig
 let SolveInternalUnknowns g (cenv: cenv) denvAtEnd moduleContents extraAttribs =
     let unsolved = FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd moduleContents extraAttribs
 
-    for tp in unsolved do
-        if (tp.Rigidity <> TyparRigidity.Rigid) && not tp.IsSolved then 
-            ChooseTyparSolutionAndSolve cenv.css denvAtEnd tp
+    ChooseSolutionsForUnsolved cenv.css denvAtEnd unsolved
 
 let CheckModuleSignature g (cenv: cenv) m denvAtEnd rootSigOpt implFileTypePriorToSig implFileSpecPriorToSig moduleContents =
     match rootSigOpt with 
@@ -5200,25 +5184,27 @@ let CheckOneImplFile
         conditionalDefines,
         tcSink,
         isInternalTestSpanStackReferring,
-        env,
+        env: TcEnv,
         rootSigOpt: ModuleOrNamespaceType option,
         synImplFile) =
 
     let (ParsedImplFileInput (_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile
     let infoReader = InfoReader(g, amap)
 
     cancellable {
+        let envinner, moduleTyAcc = MakeInitialEnv env 
+
+        let tcVal = LightweightTcValForUsingInBuildMethodCall g envinner.TraitContext
+
         let cenv = 
             cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt,
-                conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,
+                conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring,
                 tcPat=TcPat,
                 tcSimplePats=TcSimplePats,
                 tcSequenceExpressionEntry=TcSequenceExpressionEntry,
                 tcArrayOrListSequenceExpression=TcArrayOrListComputedExpression,
                 tcComputationExpression=TcComputationExpression)    
 
-        let envinner, moduleTyAcc = MakeInitialEnv env 
-
         let defs = [ for x in implFileFrags -> SynModuleDecl.NamespaceFragment x ]
         let! moduleContents, topAttrs, envAtEnd = TcModuleOrNamespaceElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDoc.Empty None openDecls0 defs
 
@@ -5294,7 +5280,7 @@ let CheckOneImplFile
 
                 try  
                     let reportErrors = not (checkForErrors())
-                    let tcVal = LightweightTcValForUsingInBuildMethodCall g
+                    let tcVal = LightweightTcValForUsingInBuildMethodCall g envAtEnd.TraitContext
                     PostTypeCheckSemanticChecks.CheckImplFile 
                        (g, cenv.amap, reportErrors, cenv.infoReader, 
                         env.eInternalsVisibleCompPaths, cenv.thisCcu, tcVal, envAtEnd.DisplayEnv, 
@@ -5335,18 +5321,20 @@ let CheckOneImplFile
 /// Check an entire signature file
 let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring) tcEnv (sigFile: ParsedSigFileInput) = 
  cancellable {     
+    let envinner, moduleTyAcc = MakeInitialEnv tcEnv 
+
+    let tcVal = LightweightTcValForUsingInBuildMethodCall g envinner.TraitContext
+
     let cenv = 
         cenv.Create 
             (g, false, amap, thisCcu, true, false, conditionalDefines, tcSink,
-             (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,
+             tcVal, isInternalTestSpanStackReferring,
              tcPat=TcPat,
              tcSimplePats=TcSimplePats,
              tcSequenceExpressionEntry=TcSequenceExpressionEntry,
              tcArrayOrListSequenceExpression=TcArrayOrListComputedExpression,
              tcComputationExpression=TcComputationExpression)
 
-    let envinner, moduleTyAcc = MakeInitialEnv tcEnv 
-
     let specs = [ for x in sigFile.Contents -> SynModuleSigDecl.NamespaceFragment x ]
     let! tcEnv = TcSignatureElements cenv ParentNone sigFile.QualifiedName.Range envinner PreXmlDoc.Empty None specs