Skip to content

Commit

Permalink
extension witness implementation
Browse files Browse the repository at this point in the history
  • Loading branch information
dsyme committed Jan 20, 2020
1 parent e07132b commit 6452dba
Show file tree
Hide file tree
Showing 31 changed files with 609 additions and 309 deletions.
3 changes: 3 additions & 0 deletions src/fsharp/AccessibilityLogic.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand All @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/CheckFormatStrings.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand Down
1 change: 0 additions & 1 deletion src/fsharp/CompileOptions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
352 changes: 224 additions & 128 deletions src/fsharp/ConstraintSolver.fs

Large diffs are not rendered by default.

23 changes: 18 additions & 5 deletions src/fsharp/ConstraintSolver.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
2 changes: 1 addition & 1 deletion src/fsharp/FSComp.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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."
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/FindUnsolved.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
12 changes: 6 additions & 6 deletions src/fsharp/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down
35 changes: 30 additions & 5 deletions src/fsharp/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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'
Expand Down Expand Up @@ -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

Expand All @@ -391,6 +401,7 @@ type NameResolutionEnv =
eFullyQualifiedTyconsByAccessNames = LayeredMultiMap.Empty
eFullyQualifiedTyconsByDemangledNameAndArity = LayeredMap.Empty
eIndexedExtensionMembers = TyconRefMultiMap<_>.Empty
eExtensionMembersByName = NameMultiMap<_>.Empty
eUnindexedExtensionMembers = []
eTypars = Map.empty }

Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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.
Expand All @@ -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 }


Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -871,6 +895,7 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals)
eUnqualifiedItems = eUnqualifiedItems
ePatItems = ePatItems
eIndexedExtensionMembers = eIndexedExtensionMembers
eExtensionMembersByName = eExtensionMembersByName
eUnindexedExtensionMembers = eUnindexedExtensionMembers }

let nenv =
Expand Down
15 changes: 12 additions & 3 deletions src/fsharp/NameResolution.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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>

Expand All @@ -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

Expand Down Expand Up @@ -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

16 changes: 13 additions & 3 deletions src/fsharp/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -864,7 +864,7 @@ module private PrintTypes =
WordL.arrow ^^
(layoutTyparRefWithInfo denv env tp)) |> longConstraintPrefix]

and private layoutTraitWithInfo denv env (TTrait(tys, nm, memFlags, argtys, rty, _)) =
and private layoutTraitWithInfo denv env (TTrait(tys, nm, memFlags, argtys, rty, _, _, _)) =
let nm = DemangleOperatorName nm
if denv.shortConstraints then
WordL.keywordMember ^^ wordL (tagMember nm)
Expand All @@ -876,9 +876,19 @@ module private PrintTypes =
match tys with
| [ty] -> layoutTypeWithInfo denv env ty
| tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys)
tysL ^^ wordL (tagPunctuation ":") ---

let argtys =
if memFlags.IsInstance then
match argtys with
| [] | [_] -> [denv.g.unit_ty]
| _ :: rest -> rest
else argtys

let argtysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argtys

tysL ^^ wordL (tagPunctuation ":") ---
bracketL (stat ++ wordL (tagMember nm) ^^ wordL (tagPunctuation ":") ---
((layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argtys --- wordL (tagPunctuation "->")) --- (layoutTypeWithInfo denv env rty)))
((argtysL --- wordL (tagPunctuation "->")) --- (layoutTypeWithInfo denv env rty)))


/// Layout a unit expression
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/PostInferenceChecks.fs
Original file line number Diff line number Diff line change
Expand Up @@ -325,7 +325,7 @@ let rec CheckTypeDeep (cenv: cenv) ((visitTy, visitTyconRefOpt, visitAppTyOpt, v
| TType_var tp when tp.Solution.IsSome ->
for cx in tp.Constraints do
match cx with
| TyparConstraint.MayResolveMember((TTrait(_, _, _, _, _, soln)), _) ->
| TyparConstraint.MayResolveMember((TTrait(_, _, _, _, _, soln, _, _)), _) ->
match visitTraitSolutionOpt, !soln with
| Some visitTraitSolution, Some sln -> visitTraitSolution sln
| _ -> ()
Expand Down Expand Up @@ -402,7 +402,7 @@ and CheckTypeConstraintDeep cenv f g env x =
| TyparConstraint.IsReferenceType _
| TyparConstraint.RequiresDefaultConstructor _ -> ()

and CheckTraitInfoDeep cenv ((_, _, _, visitTraitSolutionOpt, _) as f) g env (TTrait(tys, _, _, argtys, rty, soln)) =
and CheckTraitInfoDeep cenv ((_, _, _, visitTraitSolutionOpt, _) as f) g env (TTrait(tys, _, _, argtys, rty, soln, _extSlns, _ad)) =
CheckTypesDeep cenv f g env tys
CheckTypesDeep cenv f g env argtys
Option.iter (CheckTypeDeep cenv f g env true ) rty
Expand Down
Loading

0 comments on commit 6452dba

Please sign in to comment.