extension witness implementation

Author: dsyme

src/fsharp/AccessibilityLogic.fs

@@ -37,6 +37,8 @@ type AccessorDomain =
     /// An AccessorDomain which returns all items
     | AccessibleFromSomewhere 
 
+    interface TraitAccessorDomain
+
     // 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) = 
@@ -45,6 +47,7 @@ type AccessorDomain =
         | AccessibleFromEverywhere -> 2
         | AccessibleFromSomeFSharpCode  -> 3
         | AccessibleFromSomewhere  -> 4
+
     static member CustomEquals(g:TcGlobals, ad1:AccessorDomain, ad2:AccessorDomain) = 
         match ad1, ad2 with 
         | AccessibleFrom(cs1, tc1), AccessibleFrom(cs2, tc2) -> (cs1 = cs2) && (match tc1, tc2 with None, None -> true | Some tc1, Some tc2 -> tyconRefEq g tc1 tc2 | _ -> false)

src/fsharp/CheckFormatStrings.fs

@@ -15,7 +15,7 @@ open FSharp.Compiler.NameResolution
 type FormatItem = Simple of TType | FuncAndVal 
 
 let copyAndFixupFormatTypar m tp = 
-    let _,_,tinst = FreshenAndFixupTypars m TyparRigidity.Flexible [] [] [tp]
+    let _,_,tinst = FreshenAndFixupTypars None m TyparRigidity.Flexible [] [] [tp]
     List.head tinst
 
 let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *)

src/fsharp/CompileOptions.fs

@@ -1716,7 +1716,6 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
     let optSettings = tcConfig.optSettings 
     let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR }
     let optSettings = { optSettings with reportingPhase = true }
-            
     let results, (optEnvFirstLoop, _, _, _) = 
         ((optEnv0, optEnv0, optEnv0, SignatureHidingInfo.Empty), implFiles) 
 

src/fsharp/ConstraintSolver.fs

@@ -7,6 +7,7 @@ open FSharp.Compiler
 open FSharp.Compiler.AccessibilityLogic
 open FSharp.Compiler.Ast
 open FSharp.Compiler.ErrorLogger
+open FSharp.Compiler.NameResolution
 open FSharp.Compiler.Tast
 open FSharp.Compiler.Range
 open FSharp.Compiler.Import
@@ -34,18 +35,27 @@ val NewErrorMeasure : unit -> Measure
 /// Create a list of inference type variables, one for each element in the input list
 val NewInferenceTypes : 'a list -> TType list
 
+/// Freshen a trait for use at a particular location
+type TraitFreshener = (TraitConstraintInfo -> TraitPossibleExtensionMemberSolutions * TraitAccessorDomain)
+
 /// Given a set of formal type parameters and their constraints, make new inference type variables for
 /// each and ensure that the constraints on the new type variables are adjusted to refer to these.
-val FreshenAndFixupTypars : range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list
+val FreshenAndFixupTypars : TraitFreshener option -> range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list
+
+/// Make new type inference variables for the use of a generic construct at a particular location
+val FreshenTypeInst : TraitFreshener option -> range -> Typars -> Typars * TyparInst * TType list
 
-val FreshenTypeInst : range -> Typars -> Typars * TyparInst * TType list
+/// Make new type inference variables for the use of a generic construct at a particular location
+val FreshenTypars : TraitFreshener option -> range -> Typars -> TType list
 
-val FreshenTypars : range -> Typars -> TType list
+/// Make new type inference variables for the use of a method at a particular location
+val FreshenMethInfo : TraitFreshener option -> range -> MethInfo -> TType list
 
-val FreshenMethInfo : range -> MethInfo -> TType list
+/// Get the trait freshener for a particular location
+val GetTraitFreshner : AccessorDomain -> NameResolutionEnv -> TraitFreshener
 
 [<RequireQualifiedAccess>] 
-/// Information about the context of a type equation.
+/// Information about the context of a type equation, for better error reporting
 type ContextInfo =
 
     /// No context was given.
@@ -163,4 +173,7 @@ val CodegenWitnessThatTypeSupportsTraitConstraint : TcValF -> TcGlobals -> Impor
 
 val ChooseTyparSolutionAndSolve : ConstraintSolverState -> DisplayEnv -> Typar -> unit
 
+/// Get the type variables that may help provide solutions to a statically resolved member trait constraint
+val GetSupportOfMemberConstraint : ConstraintSolverEnv -> TraitConstraintInfo -> Typar list
+
 val IsApplicableMethApprox : TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool

src/fsharp/ConstraintSolver.fsi

@@ -1080,7 +1080,7 @@ lexIndentOffForML,"Consider using a file with extension '.ml' or '.mli' instead"
 1212,tcOptionalArgsMustComeAfterNonOptionalArgs,"Optional arguments must come at the end of the argument list, after any non-optional arguments"
 1213,tcConditionalAttributeUsage,"Attribute 'System.Diagnostics.ConditionalAttribute' is only valid on methods or attribute classes"
 #1214,monoRegistryBugWorkaround,"Could not determine highest installed .NET framework version from Registry keys, using version 2.0"
-1215,tcMemberOperatorDefinitionInExtrinsic,"Extension members cannot provide operator overloads.  Consider defining the operator as part of the type definition instead."
+#1215,tcMemberOperatorDefinitionInExtrinsic,"Extension members cannot provide operator overloads.  Consider defining the operator as part of the type definition instead."
 1216,ilwriteMDBFileNameCannotBeChangedWarning,"The name of the MDB file must be <assembly-file-name>.mdb. The --pdb option will be ignored."
 1217,ilwriteMDBMemberMissing,"MDB generation failed. Could not find compatible member %s"
 1218,ilwriteErrorCreatingMdb,"Cannot generate MDB debug information. Failed to load the 'MonoSymbolWriter' type from the 'Mono.CompilerServices.SymbolWriter.dll' assembly."

src/fsharp/FSComp.txt

@@ -135,7 +135,7 @@ and accOp cenv env (op, tyargs, args, _m) =
         accTypeInst cenv env enclTypeArgs
         accTypeInst cenv env methTypeArgs
         accTypeInst cenv env tys
-    | TOp.TraitCall (TTrait(tys, _nm, _, argtys, rty, _sln)) -> 
+    | TOp.TraitCall (TTrait(tys, _nm, _, argtys, rty, _sln, _extSlns, _ad)) -> 
         argtys |> accTypeInst cenv env 
         rty |> Option.iter (accTy cenv env)
         tys |> List.iter (accTy cenv env)

src/fsharp/FindUnsolved.fs

@@ -1037,12 +1037,12 @@ let BuildFSharpMethodApp g m (vref: ValRef) vexp vexprty (args: Exprs) =
     retTy
 
 /// Build a call to an F# method.
-let BuildFSharpMethodCall g m (ty, vref: ValRef) valUseFlags minst args =
+let BuildFSharpMethodCall g m (vref: ValRef) valUseFlags declaringTypeInst minst args =
     let vexp = Expr.Val (vref, valUseFlags, m)
     let vexpty = vref.Type
-    let tpsorig, tau =  vref.TypeScheme
-    let vtinst = argsOfAppTy g ty @ minst
-    if tpsorig.Length <> vtinst.Length then error(InternalError("BuildFSharpMethodCall: unexpected List.length mismatch", m))
+    let tpsorig,tau =  vref.TypeScheme
+    let vtinst = declaringTypeInst @ minst
+    if tpsorig.Length <> vtinst.Length then error(InternalError("BuildFSharpMethodCall: unexpected typar length mismatch",m))
     let expr = mkTyAppExpr m (vexp, vexpty) vtinst
     let exprty = instType (mkTyparInst tpsorig vtinst) tau
     BuildFSharpMethodApp g m vref expr exprty args
@@ -1060,8 +1060,8 @@ let MakeMethInfoCall amap m minfo minst args =
         let isProp = false // not necessarily correct, but this is only used post-creflect where this flag is irrelevant 
         BuildILMethInfoCall g amap m isProp ilminfo valUseFlags minst  direct args |> fst
 
-    | FSMeth(g, ty, vref, _) -> 
-        BuildFSharpMethodCall g m (ty, vref) valUseFlags minst args |> fst
+    | FSMeth(g, _, vref, _) -> 
+        BuildFSharpMethodCall g m vref valUseFlags minfo.DeclaringTypeInst minst args |> fst
 
     | DefaultStructCtor(_, ty) -> 
        mkDefault (m, ty)

src/fsharp/MethodCalls.fs

@@ -284,6 +284,8 @@ type ExtensionMember =
    /// IL-style extension member, backed by some kind of method with an [<Extension>] attribute
    | ILExtMem of TyconRef * MethInfo * ExtensionMethodPriority
 
+   interface TraitPossibleExtensionMemberSolution 
+
    /// Check if two extension members refer to the same definition
    static member Equality g e1 e2 =
        match e1, e2 with
@@ -309,7 +311,12 @@ type ExtensionMember =
        | FSExtMem (_, pri) -> pri
        | ILExtMem (_, _, pri) -> pri
 
-type FullyQualifiedFlag =
+   member x.LogicalName = 
+       match x with 
+       | FSExtMem (vref, _) -> vref.LogicalName
+       | ILExtMem (_, minfo, _) -> minfo.LogicalName
+       
+type FullyQualifiedFlag = 
     /// Only resolve full paths
     | FullyQualified
     /// Resolve any paths accessible via 'open'
@@ -369,6 +376,9 @@ type NameResolutionEnv =
       /// Extension members by type and name
       eIndexedExtensionMembers: TyconRefMultiMap<ExtensionMember>
 
+      /// Extension members by name  
+      eExtensionMembersByName: NameMultiMap<ExtensionMember>
+
       /// Other extension members unindexed by type
       eUnindexedExtensionMembers: ExtensionMember list
 
@@ -391,6 +401,7 @@ type NameResolutionEnv =
           eFullyQualifiedTyconsByAccessNames = LayeredMultiMap.Empty
           eFullyQualifiedTyconsByDemangledNameAndArity = LayeredMap.Empty
           eIndexedExtensionMembers = TyconRefMultiMap<_>.Empty
+          eExtensionMembersByName = NameMultiMap<_>.Empty
           eUnindexedExtensionMembers = []
           eTypars = Map.empty }
 
@@ -658,6 +669,17 @@ let AddValRefToExtensionMembers pri (eIndexedExtensionMembers: TyconRefMultiMap<
     else
         eIndexedExtensionMembers
 
+/// Add an F# value to the table of available extension members, if necessary, as an FSharp-style extension member
+let AddValRefToExtensionMembersByNameTable logicalName (eExtensionMembersByName: NameMultiMap<_>) extMemInfo =
+    NameMultiMap.add logicalName extMemInfo eExtensionMembersByName
+
+/// Add an F# value to the table of available extension members, if necessary, as an FSharp-style extension member
+let AddValRefToExtensionMembersByName pri (eExtensionMembersByName: NameMultiMap<_>) (vref:ValRef) =
+    if vref.IsMember && vref.IsExtensionMember then
+        AddValRefToExtensionMembersByNameTable vref.LogicalName eExtensionMembersByName (FSExtMem (vref,pri))
+    else
+        eExtensionMembersByName
+
 
 /// This entry point is used to add some extra items to the environment for Visual Studio, e.g. static members
 let AddFakeNamedValRefToNameEnv nm nenv vref =
@@ -688,6 +710,7 @@ let AddValRefsToNameEnvWithPriority bulkAddMode pri nenv (vrefs: ValRef []) =
     { nenv with
         eUnqualifiedItems = AddValRefsToItems bulkAddMode nenv.eUnqualifiedItems vrefs
         eIndexedExtensionMembers = (nenv.eIndexedExtensionMembers, vrefs) ||> Array.fold (AddValRefToExtensionMembers pri)
+        eExtensionMembersByName = (nenv.eExtensionMembersByName, vrefs) ||> Array.fold (AddValRefToExtensionMembersByName pri)
         ePatItems = (nenv.ePatItems, vrefs) ||> Array.fold AddValRefsToActivePatternsNameEnv }
 
 /// Add a single F# value to the environment.
@@ -700,6 +723,7 @@ let AddValRefToNameEnv nenv (vref: ValRef) =
             else
                 nenv.eUnqualifiedItems
         eIndexedExtensionMembers = AddValRefToExtensionMembers pri nenv.eIndexedExtensionMembers vref
+        eExtensionMembersByName = AddValRefToExtensionMembersByName pri nenv.eExtensionMembersByName vref
         ePatItems = AddValRefsToActivePatternsNameEnv nenv.ePatItems vref }
 
 
@@ -808,12 +832,12 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals)
     let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef
     let flds =  if isIL then [| |] else tcref.AllFieldsArray
 
-    let eIndexedExtensionMembers, eUnindexedExtensionMembers =
+    let eIndexedExtensionMembers, eExtensionMembersByName, eUnindexedExtensionMembers = 
         let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m  tcref
-        ((nenv.eIndexedExtensionMembers, nenv.eUnindexedExtensionMembers), ilStyleExtensionMeths) ||> List.fold (fun (tab1, tab2) extMemInfo ->
+        ((nenv.eIndexedExtensionMembers, nenv.eExtensionMembersByName, nenv.eUnindexedExtensionMembers),ilStyleExtensionMeths) ||> List.fold (fun (tab1,tab2,tab3) extMemInfo -> 
             match extMemInfo with
-            | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2
-            | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2)
+            | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), AddValRefToExtensionMembersByNameTable extMemInfo.LogicalName tab2 extMemInfo, tab3
+            | Choice2Of2 extMemInfo -> tab1, AddValRefToExtensionMembersByNameTable extMemInfo.LogicalName tab2 extMemInfo, extMemInfo :: tab3)  
 
     let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute tcref.Attribs)
     let eFieldLabels =
@@ -871,6 +895,7 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals)
             eUnqualifiedItems = eUnqualifiedItems
             ePatItems = ePatItems
             eIndexedExtensionMembers = eIndexedExtensionMembers
+            eExtensionMembersByName = eExtensionMembersByName
             eUnindexedExtensionMembers = eUnindexedExtensionMembers }
 
     let nenv = 

src/fsharp/NameResolution.fs

@@ -150,6 +150,11 @@ type ExtensionMember =
    /// IL-style extension member, backed by some kind of method with an [<Extension>] attribute
    | ILExtMem of TyconRef * MethInfo * ExtensionMethodPriority
 
+   interface TraitPossibleExtensionMemberSolution 
+
+   /// The logical name, e.g. for constraint solving
+   member LogicalName : string
+
    /// Describes the sequence order of the introduction of an extension method. Extension methods that are introduced
    /// later through 'open' get priority in overload resolution.
    member Priority : ExtensionMethodPriority
@@ -169,8 +174,9 @@ type NameResolutionEnv =
       /// Modules accessible via "." notation. Note this is a multi-map. 
       /// Adding a module abbreviation adds it a local entry to this List.map. 
       /// Likewise adding a ccu or opening a path adds entries to this List.map. 
+      
       eModulesAndNamespaces:  NameMultiMap<Tast.ModuleOrNamespaceRef>
-
+      
       /// Fully qualified modules and namespaces. 'open' does not change this. 
       eFullyQualifiedModulesAndNamespaces:  NameMultiMap<Tast.ModuleOrNamespaceRef>
 
@@ -195,6 +201,9 @@ type NameResolutionEnv =
       /// Extension members by type and name 
       eIndexedExtensionMembers: TyconRefMultiMap<ExtensionMember>
 
+      /// Extension members by name 
+      eExtensionMembersByName: NameMultiMap<ExtensionMember>
+
       /// Other extension members unindexed by type
       eUnindexedExtensionMembers: ExtensionMember list
 
@@ -589,5 +598,5 @@ val GetVisibleNamespacesAndModulesAtPoint : NameResolver -> NameResolutionEnv ->
 
 val IsItemResolvable : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool
 
-val TrySelectExtensionMethInfoOfILExtMem : range -> ImportMap -> TType -> TyconRef * MethInfo * ExtensionMethodPriority -> MethInfo option 
- 
+val TrySelectExtensionMethInfoOfILExtMem : range -> ImportMap -> TType -> TyconRef * MethInfo * ExtensionMethodPriority -> MethInfo option
+