diff --git a/.gitignore b/.gitignore index 3cfeb6c1cb3..0ffce78e058 100644 --- a/.gitignore +++ b/.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 diff --git a/src/Compiler/Checking/AccessibilityLogic.fs b/src/Compiler/Checking/AccessibilityLogic.fs index 4a70f268ddf..b3e68876c72 100644 --- a/src/Compiler/Checking/AccessibilityLogic.fs +++ b/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) = diff --git a/src/Compiler/Checking/AccessibilityLogic.fsi b/src/Compiler/Checking/AccessibilityLogic.fsi index fb51c1a101f..6789c42530e 100644 --- a/src/Compiler/Checking/AccessibilityLogic.fsi +++ b/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 diff --git a/src/Compiler/Checking/CheckBasics.fs b/src/Compiler/Checking/CheckBasics.fs index 18f457ef887..9f1e85aa73f 100644 --- a/src/Compiler/Checking/CheckBasics.fs +++ b/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) + 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 diff --git a/src/Compiler/Checking/CheckBasics.fsi b/src/Compiler/Checking/CheckBasics.fsi index 389b716e1c8..6c905c69978 100644 --- a/src/Compiler/Checking/CheckBasics.fsi +++ b/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 diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index db8d307381f..cfdf7a1a6c2 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/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 diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e9272db3bc0..f05d01dcd67 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/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,7 +3846,7 @@ 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 @@ -3855,7 +3854,7 @@ module TcDeclarations = | _ -> 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,7 +5184,7 @@ let CheckOneImplFile conditionalDefines, tcSink, isInternalTestSpanStackReferring, - env, + env: TcEnv, rootSigOpt: ModuleOrNamespaceType option, synImplFile) = @@ -5208,17 +5192,19 @@ let CheckOneImplFile 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 diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs old mode 100644 new mode 100755 index fecd9e6c09a..f2366749bd7 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -422,8 +422,8 @@ type CheckedBindingInfo = type cenv = TcFileState -let CopyAndFixupTypars g m rigid tpsorig = - FreshenAndFixupTypars g m rigid [] [] tpsorig +let CopyAndFixupTypars g traitFreshner m rigid tpsorig = + FreshenAndFixupTypars g traitFreshner m rigid [] [] tpsorig let UnifyTypes (cenv: cenv) (env: TcEnv) m actualTy expectedTy = let g = cenv.g @@ -768,7 +768,7 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst = | SynMeasure.One -> Measure.One | SynMeasure.Named(tc, m) -> let ad = env.eAccessRights - let _, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let _, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad env.TraitContext tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match tcref.TypeOrMeasureKind with | TyparKind.Type -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) | TyparKind.Measure -> Measure.Const tcref @@ -1025,7 +1025,7 @@ let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, implS if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(name, n), m)) if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments name, m)) - if isExtrinsic && IsLogicalOpName id.idText then + if isExtrinsic && IsLogicalOpName id.idText && not (g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions) then warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(), id.idRange)) PrelimMemberInfo(memberInfo, logicalName, compiledName) @@ -1717,7 +1717,7 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> // to C<_> occurs then generate C for a fresh type inference variable ?ty. //------------------------------------------------------------------------- -let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = +let FreshenTyconRef traitFreshner (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = let origTypars = declaredTyconTypars let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers let freshTypars = copyTypars clearStaticReq origTypars @@ -1725,32 +1725,28 @@ let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars for tp in freshTypars do tp.SetRigidity rigid - let renaming, tinst = FixupNewTypars m [] [] origTypars freshTypars + let renaming, tinst = FixupNewTypars traitFreshner m [] [] origTypars freshTypars let origTy = TType_app(tcref, List.map mkTyparTy origTypars, g.knownWithoutNull) let freshTy = TType_app(tcref, tinst, g.knownWithoutNull) origTy, freshTypars, renaming, freshTy -let FreshenPossibleForallTy g m rigid ty = +let FreshenPossibleForallTy traitFreshner g m rigid ty = let origTypars, tau = tryDestForallTy g ty if isNil origTypars then [], [], [], tau else // tps may be have been equated to other tps in equi-recursive type inference and units-of-measure type inference. Normalize them here let origTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g origTypars - let tps, renaming, tinst = CopyAndFixupTypars g m rigid origTypars + let tps, renaming, tinst = CopyAndFixupTypars g traitFreshner m rigid origTypars origTypars, tps, tinst, instType renaming tau -let FreshenTyconRef2 (g: TcGlobals) m (tcref: TyconRef) = - let tps, renaming, tinst = FreshenTypeInst g m (tcref.Typars m) +let FreshenTyconRef2 traitFreshner (g: TcGlobals) m (tcref: TyconRef) = + let tps, renaming, tinst = FreshenTypeInst g traitFreshner m (tcref.Typars m) tps, renaming, tinst, TType_app (tcref, tinst, g.knownWithoutNull) -/// Given a abstract method, which may be a generic method, freshen the type in preparation -/// to apply it as a constraint to the method that implements the abstract slot -let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = - - // Work out if an explicit instantiation has been given. If so then the explicit type - // parameters will be made rigid and checked for generalization. If not then auto-generalize - // by making the copy of the type parameters on the virtual being overridden rigid. +/// Given a abstract method, which may be a generic method, freshen the type in preparation +/// to apply it as a constraint to the method that implements the abstract slot +let FreshenAbstractSlot traitFreshner g amap m synTyparDecls absMethInfo = let typarsFromAbsSlotAreRigid = @@ -1768,7 +1764,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = let ttps = absMethInfo.GetFormalTyparsOfDeclaringType m let ttinst = argsOfAppTy g absMethInfo.ApparentEnclosingType let rigid = if typarsFromAbsSlotAreRigid then TyparRigidity.Rigid else TyparRigidity.Flexible - FreshenAndFixupTypars g m rigid ttps ttinst fmtps + FreshenAndFixupTypars g traitFreshner m rigid ttps ttinst fmtps // Work out the required type of the member let argTysFromAbsSlot = argTys |> List.mapSquared (instType typarInstFromAbsSlot) @@ -1793,7 +1789,7 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' flds |> List.map (fun (fld, fldExpr) -> let (fldPath, fldId) = fld - let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fldPath fldId allFields + let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad env.TraitContext ty fldPath fldId allFields fld, frefSet, fldExpr) let relevantTypeSets = @@ -1900,7 +1896,7 @@ let TcUnionCaseOrExnField (cenv: cenv) (env: TcEnv) ty1 m longId fieldNum funcs let ad = env.eAccessRights let mkf, argTys, _argNames = - match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with + match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false m ad env.TraitContext env.eNameResEnv TypeNameResolutionInfo.Default longId with | Item.UnionCase _ | Item.ExnCase _ as item -> ApplyUnionCaseOrExn funcs m cenv env ty1 item | _ -> error(Error(FSComp.SR.tcUnknownUnion(), m)) @@ -2374,7 +2370,7 @@ module BindingNormalization = let typars = match tyargs with None -> inferredTyparDecls | Some typars -> typars match memberFlagsOpt with | None -> - match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.NameEnv TypeNameResolutionInfo.Default longId with + match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.TraitContext env.NameEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> if id.idText = opNameCons then NormalizedBindingPat(pat, rhsExpr, valSynData, typars) @@ -2519,7 +2515,7 @@ module EventDeclarationNormalization = /// Make a copy of the "this" type for a generic object type, e.g. List<'T> --> List<'?> for a fresh inference variable. /// Also adjust the "this" type to take into account whether the type is a struct. -let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTypars = +let FreshenObjectArgType (cenv: cenv) traitFreshner m rigid tcref isExtrinsic declaredTyconTypars = let g = cenv.g #if EXTENDED_EXTENSION_MEMBERS // indicates if extension members can add additional constraints to type parameters @@ -2527,7 +2523,7 @@ let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTyp FreshenTyconRef g m (if isExtrinsic then TyparRigidity.Flexible else rigid) tcref declaredTyconTypars #else let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy = - FreshenTyconRef g m rigid tcref declaredTyconTypars + FreshenTyconRef traitFreshner g m rigid tcref declaredTyconTypars #endif // Struct members have a byref 'this' type (unless they are extrinsic extension members) @@ -2590,7 +2586,7 @@ let TcValEarlyGeneralizationConsistencyCheck (cenv: cenv) (env: TcEnv) (v: Val, /// instantiationInfoOpt is is also set when building the final call for a reference to an /// F# object model member, in which case the instantiationInfoOpt is the type instantiation /// inferred by member overload resolution. -let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiationInfoOpt optAfterResolution m = +let TcVal checkAttributes (cenv: cenv) (env: TcEnv) (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiationInfoOpt optAfterResolution m = let g = cenv.g let tpsorig, _, _, _, tinst, _ as res = @@ -2617,7 +2613,7 @@ let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValR // The value may still be generic, e.g. // [] // let Null = null - let tpsorig, _, tinst, tauTy = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + let tpsorig, _, tinst, tauTy = FreshenPossibleForallTy env.TraitContext g m TyparRigidity.Flexible vTy tpsorig, Expr.Const (c, m, tauTy), isSpecial, tauTy, tinst, tpenv | None -> @@ -2647,7 +2643,7 @@ let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValR tpsorig, NormalValUse, tinst, tau, tpenv | ValInRecScope true | ValNotInRecScope -> - let tpsorig, _, tinst, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + let tpsorig, _, tinst, tau = FreshenPossibleForallTy env.TraitContext g m TyparRigidity.Flexible vTy tpsorig, NormalValUse, tinst, tau, tpenv // If we have got an explicit instantiation then use that @@ -2674,7 +2670,7 @@ let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValR | ValInRecScope true | ValNotInRecScope -> - let vTypars, tps, tpTys, vTauTy = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + let vTypars, tps, tpTys, vTauTy = FreshenPossibleForallTy env.TraitContext g m TyparRigidity.Flexible vTy let tinst, tpenv = checkTys tpenv (tps |> List.map (fun tp -> tp.Kind)) @@ -2706,7 +2702,7 @@ let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValR /// simplified version of TcVal used in calls to BuildMethodCall (typrelns.fs) /// this function is used on typechecking step for making calls to provided methods and on optimization step (for the same purpose). -let LightweightTcValForUsingInBuildMethodCall g (vref: ValRef) vrefFlags (vrefTypeInst: TTypes) m = +let LightweightTcValForUsingInBuildMethodCall g traitCtxt (vref: ValRef) vrefFlags (vrefTypeInst: TTypes) m = let v = vref.Deref let vTy = vref.Type // byref-typed values get dereferenced @@ -2715,14 +2711,14 @@ let LightweightTcValForUsingInBuildMethodCall g (vref: ValRef) vrefFlags (vrefTy else match v.LiteralValue with | Some literalConst -> - let _, _, _, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + let _, _, _, tau = FreshenPossibleForallTy traitCtxt g m TyparRigidity.Flexible vTy Expr.Const (literalConst, m, tau), tau | None -> // Instantiate the value let tau = // If we have got an explicit instantiation then use that - let _, tps, tpTys, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + let _, tps, tpTys, tau = FreshenPossibleForallTy traitCtxt g m TyparRigidity.Flexible vTy if tpTys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length), m)) @@ -2912,8 +2908,8 @@ let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo // BuildInvokerExpressionForProvidedMethodCall converts references to F# intrinsics back to values // and uses TcVal to do this. However we don't want to check attributes again for provided references to values, // so we pass 'false' for 'checkAttributes'. - let tcVal = LightweightTcValForUsingInBuildMethodCall g - let _, retExpr, retTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall tcVal (g, cenv.amap, mi, objArgs, isMutable, isProp, valUseFlags, args, m) + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + let _, retExpr, retTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall tcVal (g, cenv.amap, env.TraitContext, mi, objArgs, isMutable, isProp, valUseFlags, args, m) retExpr, retTy | _ -> @@ -3116,7 +3112,7 @@ let GetMethodArgs arg = let CompilePatternForMatch (cenv: cenv) (env: TcEnv) mExpr mMatch warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy = let g = cenv.g - let dtree, targets = CompilePattern g env.DisplayEnv cenv.amap (LightweightTcValForUsingInBuildMethodCall g) cenv.infoReader mExpr mMatch warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy + let dtree, targets = CompilePattern g env.DisplayEnv cenv.amap (LightweightTcValForUsingInBuildMethodCall g env.TraitContext) cenv.infoReader mExpr mMatch warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy mkAndSimplifyMatch DebugPointAtBinding.NoneAtInvisible mExpr mMatch resultTy dtree targets /// Compile a pattern @@ -3167,7 +3163,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr | Exception exn -> Exception exn | Result getEnumeratorMethInfo -> - let getEnumeratorMethInst = FreshenMethInfo m getEnumeratorMethInfo + let getEnumeratorMethInst = FreshenMethInfo g env.TraitContext m getEnumeratorMethInfo let getEnumeratorRetTy = getEnumeratorMethInfo.GetFSharpReturnType(cenv.amap, m, getEnumeratorMethInst) if hasArgs getEnumeratorMethInfo getEnumeratorMethInst then err true tyToSearchForGetEnumeratorAndItem else @@ -3175,7 +3171,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr | Exception exn -> Exception exn | Result moveNextMethInfo -> - let moveNextMethInst = FreshenMethInfo m moveNextMethInfo + let moveNextMethInst = FreshenMethInfo g env.TraitContext m moveNextMethInfo let moveNextRetTy = moveNextMethInfo.GetFSharpReturnType(cenv.amap, m, moveNextMethInst) if not (typeEquiv g g.bool_ty moveNextRetTy) then err false getEnumeratorRetTy else if hasArgs moveNextMethInfo moveNextMethInst then err false getEnumeratorRetTy else @@ -3184,7 +3180,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr | Exception exn -> Exception exn | Result getCurrentMethInfo -> - let getCurrentMethInst = FreshenMethInfo m getCurrentMethInfo + let getCurrentMethInst = FreshenMethInfo g env.TraitContext m getCurrentMethInfo if hasArgs getCurrentMethInfo getCurrentMethInst then err false getEnumeratorRetTy else let enumElemTy = getCurrentMethInfo.GetFSharpReturnType(cenv.amap, m, getCurrentMethInst) @@ -3969,7 +3965,7 @@ let rec TcTyparConstraint ridx (cenv: cenv) newOk checkConstraints occ (env: TcE let tps = List.map (destTyparTy g) tinst //, _, tinst, _ = FreshenTyconRef2 g m tcref let tprefInst, _tptys = mkTyparToTyparRenaming tpsorig tps //let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (tp.Constraints @ CopyTyparConstraints m tprefInst tporig)) + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (tp.Constraints @ CopyTyparConstraints env.TraitContext m tprefInst tporig)) | CheckCxs -> () | AppTy g (_tcref, selfTy :: _rest) when isTyparTy g selfTy && isInterfaceTy g tyR -> AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace tyR selfTy @@ -4006,7 +4002,7 @@ and TcConstraintWhereTyparSupportsMember cenv env newOk tpenv synSupportTys synM let g = cenv.g let traitInfo, tpenv = TcPseudoMemberSpec cenv newOk env synSupportTys tpenv synMemberSig m match traitInfo with - | TTrait(objTys, ".ctor", memberFlags, argTys, returnTy, _) when memberFlags.MemberKind = SynMemberKind.Constructor -> + | TTrait(objTys, ".ctor", memberFlags, argTys, returnTy, _, _) when memberFlags.MemberKind = SynMemberKind.Constructor -> match objTys, argTys with | [ty], [] when typeEquiv g ty (GetFSharpViewOfReturnType g returnTy) -> AddCxTypeMustSupportDefaultCtor env.DisplayEnv cenv.css m NoTrace ty @@ -4055,7 +4051,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let item = Item.ArgName (Some id, memberConstraintTy, None, id.idRange) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) - TTrait(tys, logicalCompiledName, memberFlags, argTys, returnTy, ref None), tpenv + TTrait(tys, logicalCompiledName, memberFlags, argTys, returnTy, ref None, env.TraitContext), tpenv | _ -> error(Error(FSComp.SR.tcInvalidConstraint(), m)) @@ -4073,7 +4069,7 @@ and TcValSpec (cenv: cenv) env declKind newOk containerInfo memFlagsOpt thisTyOp | Some(MemberOrValContainerInfo(tcref, _, _, _, declaredTyconTypars)) -> let isExtrinsic = (declKind = ExtrinsicExtensionBinding) let _, enclosingDeclaredTypars, _, _, thisTy = - FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars + FreshenObjectArgType cenv env.TraitContext m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars // An implemented interface type is in terms of the type's type parameters. // We need a signature in terms of the values' type parameters. @@ -4382,7 +4378,7 @@ and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tp let m = synLongId.Range let ad = env.eAccessRights - let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad env.TraitContext tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) CheckIWSAM cenv env checkConstraints iwsam m tcref @@ -4406,7 +4402,7 @@ and TcLongIdentAppType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env let tinstEnclosing, tcref = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length - ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No + ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad env.TraitContext tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise CheckIWSAM cenv env checkConstraints iwsam m tcref @@ -4442,7 +4438,7 @@ and TcNestedAppType (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synL let leftTy, tpenv = TcType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy match leftTy with | AppTy g (tcref, tinst) -> - let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId + let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad env.TraitContext m tcref longId TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinst args | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), m)) @@ -4859,7 +4855,7 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps, _, tinst, _ = FreshenTyconRef2 g m tcref + let tps, _, tinst, _ = FreshenTyconRef2 env.TraitContext g m tcref // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. @@ -5405,8 +5401,8 @@ and TcAdjustExprForTypeDirectedConversions (cenv: cenv) (overallTy: OverallTy) a match overallTy with | MustConvertTo (isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions || (g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg) -> - let tcVal = LightweightTcValForUsingInBuildMethodCall g - AdjustExprForTypeDirectedConversions tcVal g cenv.amap cenv.infoReader env.AccessRights reqdTy actualTy m expr + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + AdjustExprForTypeDirectedConversions tcVal g cenv.amap env.TraitContext cenv.infoReader env.AccessRights reqdTy actualTy m expr | _ -> expr @@ -6189,7 +6185,7 @@ and TcTyparExprThen (cenv: cenv) overallTy env tpenv synTypar m delayed = let mExprAndLongId = unionRanges synTypar.Range ident.idRange let ty = mkTyparTy tp let lookupKind = LookupKind.Expr LookupIsInstance.Ambivalent - let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv lookupKind ident.idRange ad ident IgnoreOverrides TypeNameResolutionInfo.Default ty + let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv lookupKind ident.idRange ad env.TraitContext ident IgnoreOverrides TypeNameResolutionInfo.Default ty let delayed3 = match rest with | [] -> delayed2 @@ -6702,7 +6698,7 @@ and FreshenObjExprAbstractSlot (cenv: cenv) (env: TcEnv) (implTy: TType) virtNam | [ (_, absSlot) ] -> let typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = - FreshenAbstractSlot g cenv.amap mBinding synTyparDecls absSlot + FreshenAbstractSlot env.TraitContext g cenv.amap mBinding synTyparDecls absSlot // Work out the required type of the member let bindingTy = mkFunTy cenv.g implTy (mkMethodTy cenv.g argTysFromAbsSlot retTyFromAbsSlot) @@ -6765,7 +6761,7 @@ and TcObjectExprBinding (cenv: cenv) (env: TcEnv) implTy tpenv (absSlotInfo, bin | _ -> declaredTypars // Canonicalize constraints prior to generalization - CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars + CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars true let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env @@ -6960,7 +6956,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI | Some x -> x | None -> error(Error(FSComp.SR.tcAtLeastOneOverrideIsInvalid(), mObjTy)) - yield TObjExprMethod(overridden.GetSlotSig(cenv.amap, m), bindingAttribs, mtps, [thisVal] :: methodVars, bindingBody, id.idRange) ] + yield TObjExprMethod(overridden.GetSlotSig(cenv.amap, m, env.TraitContext), bindingAttribs, mtps, [thisVal] :: methodVars, bindingBody, id.idRange) ] (implTy, overrides')) let objtyR, overrides' = allTypeImpls.Head @@ -7613,7 +7609,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s // try optimize 'for i in span do' for span or readonlyspan match tryGetOptimizeSpanMethods g mWholeExpr enumExprTy with | ValueSome(getItemMethInfo, getLengthMethInfo, isReadOnlySpan) -> - let tcVal = LightweightTcValForUsingInBuildMethodCall g + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext let spanVar, spanExpr = mkCompGenLocal mEnumExpr "span" enumExprTy let idxVar, idxExpr = mkCompGenLocal mPat "idx" g.int32_ty let (_, elemTy) = if isReadOnlySpan then destReadOnlySpanTy g mWholeExpr enumExprTy else destSpanTy g mWholeExpr enumExprTy @@ -7940,7 +7936,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = // However we don't commit for a type names - nameof allows 'naked' type names and thus all type name // resolutions are checked separately in the next step. let typeNameResInfo = GetLongIdentTypeNameInfo delayed - let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId + let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.TraitContext env.eNameResEnv typeNameResInfo longId let resolvesAsExpr = match nameResolutionResult with | Result (_, item, _, _, _ as res) @@ -7961,7 +7957,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = let resolvedToTypeName = if (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) then let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed - match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad env.TraitContext longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with | Result (tinstEnclosing, tcref) when IsEntityAccessible cenv.amap m ad tcref -> match delayed with | [DelayedTypeApp (tyargs, _, mExprAndTypeArgs)] -> @@ -8157,7 +8153,7 @@ and TcLongIdentThen (cenv: cenv) (overallTy: OverallTy) env tpenv (SynLongIdent( let ad = env.eAccessRights let typeNameResInfo = GetLongIdentTypeNameInfo delayed let nameResolutionResult = - ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId + ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.TraitContext env.eNameResEnv typeNameResInfo longId |> ForceRaise TcItemThen cenv overallTy env tpenv nameResolutionResult None delayed @@ -8249,7 +8245,7 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env mkConstrApp, [ucaseAppTy], [ for s, m in apinfo.ActiveTagsWithRanges -> mkSynId m s ] | _ -> let ucref = mkChoiceCaseRef g mItem aparity n - let _, _, tinst, _ = FreshenTyconRef2 g mItem ucref.TyconRef + let _, _, tinst, _ = FreshenTyconRef2 env.TraitContext g mItem ucref.TyconRef let ucinfo = UnionCaseInfo (tinst, ucref) ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo, false)) | _ -> @@ -8397,7 +8393,7 @@ and TcTypeItemThen (cenv: cenv) overallTy env nm ty tpenv mItem tinstEnclosing d let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed - let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.TraitContext env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) None otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> @@ -8606,7 +8602,7 @@ and TcImplicitOpItemThen (cenv: cenv) overallTy env id sln tpenv mItem delayed = let memberFlags = StaticMemberFlags SynMemberKind.Member let logicalCompiledName = ComputeLogicalName id memberFlags - let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln) + let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln, env.TraitContext) let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) let expr = mkLambdas g mItem [] vs (expr, retTy) @@ -8942,9 +8938,9 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Canonicalize inference problem prior to '.' lookup on variable types if isTyparTy g objExprTy then - CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight g false objExprTy) + CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight g false objExprTy) false - let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.TraitContext env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution = @@ -9129,7 +9125,7 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai // This checks for and drops the 'object' sender let argsTy = ArgsTypeOfEventInfo cenv.infoReader mItem ad einfo - if not (slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(cenv.amap, mItem))) then errorR (nonStandardEventError einfo.EventName mItem) + if not (slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(cenv.amap, mItem, env.TraitContext))) then errorR (nonStandardEventError einfo.EventName mItem) let delEventTy = mkIEventType g delTy argsTy let bindObjArgs f = @@ -9151,7 +9147,7 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai mkLambda mItem dv (callExpr, g.unit_ty)) (let fvty = mkFunTy g g.obj_ty (mkFunTy g argsTy g.unit_ty) let fv, fe = mkCompGenLocal mItem "callback" fvty - let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, delTy, delInvokeMeth, delArgTys, fe, fvty, mItem) + let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, env.TraitContext, delTy, delInvokeMeth, delArgTys, fe, fvty, mItem) mkLambda mItem fv (createExpr, delTy))) let exprTy = delEventTy @@ -9410,12 +9406,12 @@ and TcMethodApplication_UniqueOverloadInference let callerArgs = { Unnamed = unnamedCurriedCallerArgs; Named = namedCurriedCallerArgs } let makeOneCalledMeth (minfo, pinfoOpt, usesParamArrayConversion) = - let minst = FreshenMethInfo mItem minfo + let minst = FreshenMethInfo g env.TraitContext mItem minfo let callerTyArgs = match tyArgsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst - CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo g env.TraitContext, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt) let preArgumentTypeCheckingCalledMethGroup = [ for minfo, pinfoOpt in candidateMethsAndProps do @@ -9541,7 +9537,7 @@ and TcAdhocChecksOnLibraryMethods (cenv: cenv) (env: TcEnv) isInstance (finalCal and TcMethodApplication isCheckingAttributeCall (cenv: cenv) - env + (env: TcEnv) tpenv tyArgsOpt objArgs @@ -9627,13 +9623,14 @@ and TcMethodApplication match tyArgsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst - CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt)) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo g env.TraitContext, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt)) // Commit unassociated constraints prior to member overload resolution where there is ambiguity // about the possible target of the call. if not uniquelyResolved then CanonicalizePartialInferenceProblem cenv.css denv mItem (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight g false callerArg.CallerArgumentType)) + false let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName callerArgs ad postArgumentTypeCheckingCalledMethGroup true returnTy @@ -9702,8 +9699,8 @@ and TcMethodApplication /// STEP 5. Build the argument list. Adjust for optional arguments, byref arguments and coercions. let objArgPreBinder, objArgs, allArgsPreBinders, allArgs, allArgsCoerced, optArgPreBinder, paramArrayPreBinders, outArgExprs, outArgTmpBinds = - let tcVal = LightweightTcValForUsingInBuildMethodCall g - AdjustCallerArgs tcVal TcFieldInit env.eCallerMemberName cenv.infoReader ad finalCalledMeth objArgs lambdaVars mItem mMethExpr + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + AdjustCallerArgs tcVal TcFieldInit env.eCallerMemberName cenv.infoReader ad env.TraitContext finalCalledMeth objArgs lambdaVars mItem mMethExpr // Record the resolution of the named argument for the Language Service allArgs |> List.iter (fun assignedArg -> @@ -9831,8 +9828,8 @@ and TcSetterArgExpr (cenv: cenv) env denv objExpr ad assignedSetter calledFromCo MethInfoChecks g cenv.amap true None [objExpr] ad m pminfo let calledArgTy = List.head (List.head (pminfo.GetParamTypes(cenv.amap, m, pminst))) - let tcVal = LightweightTcValForUsingInBuildMethodCall g - let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap env.TraitContext cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) let action = BuildPossiblyConditionalMethodCall cenv env mut m true pminfo NormalValUse pminst [objExpr] [argExpr] propStaticTyOpt |> fst argExprPrebinder, action, Item.Property (pinfo.PropertyName, [pinfo]) @@ -9841,8 +9838,8 @@ and TcSetterArgExpr (cenv: cenv) env denv objExpr ad assignedSetter calledFromCo // Get or set instance IL field ILFieldInstanceChecks g cenv.amap ad m finfo let calledArgTy = finfo.FieldType (cenv.amap, m) - let tcVal = LightweightTcValForUsingInBuildMethodCall g - let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap env.TraitContext cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr let action = BuildILFieldSet g m objExpr finfo argExpr argExprPrebinder, action, Item.ILField finfo @@ -9850,8 +9847,8 @@ and TcSetterArgExpr (cenv: cenv) env denv objExpr ad assignedSetter calledFromCo RecdFieldInstanceChecks g cenv.amap ad m rfinfo let calledArgTy = rfinfo.FieldType CheckRecdFieldMutation m denv rfinfo - let tcVal = LightweightTcValForUsingInBuildMethodCall g - let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr + let tcVal = LightweightTcValForUsingInBuildMethodCall g env.TraitContext + let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap env.TraitContext cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr let action = BuildRecdFieldSet g m objExpr rfinfo argExpr argExprPrebinder, action, Item.RecdField rfinfo @@ -9968,7 +9965,7 @@ and TcNewDelegateThen cenv (overallTy: OverallTy) env tpenv mDelTy mExprAndArg d | [synFuncArg], [] -> let m = synArg.Range let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(delFuncTy, m, false, synFuncArg)) - let expr = BuildNewDelegateExpr (None, g, cenv.amap, delegateTy, delInvokeMeth, delArgTys, callerArg.Expr, delFuncTy, m) + let expr = BuildNewDelegateExpr (None, g, cenv.amap, env.TraitContext, delegateTy, delInvokeMeth, delArgTys, callerArg.Expr, delFuncTy, m) PropagateThenTcDelayed cenv overallTy env tpenv m (MakeApplicableExprNoFlex cenv expr) intermediateTy atomicFlag delayed | _ -> error(Error(FSComp.SR.tcDelegateConstructorMustBePassed(), mExprAndArg)) @@ -10543,7 +10540,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let tyid = mkSynId tyid.idRange n let tycon = (typath @ [tyid]) let ad = env.eAccessRights - match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad env.TraitContext tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze err | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute WarnOnIWSAM.Yes env tpenv (SynType.App(SynType.LongIdent(SynLongIdent(tycon, [], List.replicate tycon.Length None)), None, [], [], None, false, mAttr)) ) ForceRaise ((try1 (tyid.idText + "Attribute")) |> otherwise (fun () -> (try1 tyid.idText))) @@ -10644,7 +10641,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn if isOpt then error(Error(FSComp.SR.tcOptionalArgumentsCannotBeUsedInCustomAttribute(), m)) let m = callerArgExpr.Range let lookupKind = LookupKind.Expr LookupIsInstance.Ambivalent - let setterItem, _ = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv lookupKind m ad id IgnoreOverrides TypeNameResolutionInfo.Default ty + let setterItem, _ = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv lookupKind m ad env.TraitContext id IgnoreOverrides TypeNameResolutionInfo.Default ty let nm, isProp, argTy = match setterItem with | Item.Property (_, [pinfo]) -> @@ -10746,12 +10743,17 @@ and TcLetBinding (cenv: cenv) isUse env containerInfo declKind tpenv (synBinds, // Canonicalize constraints prior to generalization let denv = env.DisplayEnv + let isInline = + (checkedBinds |> List.forall (fun tbinfo -> + let (CheckedBindingInfo(inl, _, _, _, _, _, _, _, _, _, _, _, _, _)) = tbinfo + (inl = ValInline.Always))) CanonicalizePartialInferenceProblem cenv.css denv synBindsRange (checkedBinds |> List.collect (fun tbinfo -> let (CheckedBindingInfo(_, _, _, _, explicitTyparInfo, _, _, _, tauTy, _, _, _, _, _)) = tbinfo let (ExplicitTyparInfo(_, declaredTypars, _)) = explicitTyparInfo let maxInferredTypars = (freeInTypeLeftToRight g false tauTy) declaredTypars @ maxInferredTypars)) + isInline let lazyFreeInEnv = lazy (GeneralizationHelpers.ComputeUngeneralizableTypars env) @@ -10762,7 +10764,7 @@ and TcLetBinding (cenv: cenv) isUse env containerInfo declKind tpenv (synBinds, let (ExplicitTyparInfo(_, declaredTypars, canInferTypars)) = explicitTyparInfo let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars let generalizedTypars, prelimValSchemes2 = - let canInferTypars = GeneralizationHelpers. ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, canInferTypars, None) + let canInferTypars = GeneralizationHelpers.ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, canInferTypars, None) let maxInferredTypars = freeInTypeLeftToRight g false tauTy @@ -11003,7 +11005,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, let uniqueAbstractMeth = uniqueAbstractMeth.Instantiate(cenv.amap, m, renaming) let typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = - FreshenAbstractSlot g cenv.amap m synTyparDecls uniqueAbstractMeth + FreshenAbstractSlot envinner.TraitContext g cenv.amap m synTyparDecls uniqueAbstractMeth let declaredTypars = (if typarsFromAbsSlotAreRigid then typarsFromAbsSlot else declaredTypars) @@ -11060,7 +11062,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, let uniqueAbstractMeth = uniqueAbstractMeth.Instantiate(cenv.amap, m, renaming) let _, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = - FreshenAbstractSlot g cenv.amap m synTyparDecls uniqueAbstractMeth + FreshenAbstractSlot envinner.TraitContext g cenv.amap m synTyparDecls uniqueAbstractMeth if not (isNil typarsFromAbsSlot) then errorR(InternalError("Unexpected generic property", memberId.idRange)) @@ -11155,7 +11157,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl CheckForNonAbstractInterface declKind tcref memberFlags id.idRange let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, _ = FreshenObjectArgType cenv envinner.TraitContext mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic @@ -11180,7 +11182,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange)) let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv envinner.TraitContext mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic @@ -11267,7 +11269,7 @@ and AnalyzeRecursiveInstanceMemberDecl // The type being augmented tells us the type of 'this' let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv envinner.TraitContext mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner @@ -11734,7 +11736,12 @@ and TcIncrementalLetRecGeneralization cenv scopem else let supportForBindings = newGeneralizableBindings |> List.collect (TcLetrecComputeSupportForBinding cenv) - CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings + let isInline = + (newGeneralizableBindings |> List.forall (fun tbinfo -> + let (CheckedBindingInfo(inl, _, _, _, _, _, _, _, _, _, _, _, _, _)) = tbinfo.CheckedBinding + (inl = ValInline.Always))) + + CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings isInline let generalizedTyparsL = newGeneralizableBindings |> List.map (TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv) @@ -11785,6 +11792,7 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let canGeneralizeConstrained = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl rbinfo.DeclKind let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canGeneralizeConstrained, inlineFlag, Some expr, allDeclaredTypars, maxInferredTypars, tau, isCtor) + generalizedTypars /// Compute the type variables which may have member constraints that need to be canonicalized prior to generalization diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 5c2b0b6451f..e110187649a 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -124,7 +124,13 @@ exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: s val TcFieldInit: range -> ILFieldInit -> Const val LightweightTcValForUsingInBuildMethodCall: - g: TcGlobals -> vref: ValRef -> vrefFlags: ValUseFlag -> vrefTypeInst: TTypes -> m: range -> Expr * TType + g: TcGlobals -> + traitCtxt: ITraitContext option -> + vref: ValRef -> + vrefFlags: ValUseFlag -> + vrefTypeInst: TTypes -> + m: range -> + Expr * TType /// Indicates whether a syntactic type is allowed to include new type variables /// not declared anywhere, e.g. `let f (x: 'T option) = x.Value` @@ -475,6 +481,7 @@ val FixupLetrecBind: /// inference variables with the given rigidity. val FreshenObjectArgType: cenv: TcFileState -> + traitFreshner: ITraitContext option -> m: range -> rigid: TyparRigidity -> tcref: TyconRef -> diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index 8652e305761..6e7919b9ed1 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.TcGlobals type FormatItem = Simple of TType | FuncAndVal let copyAndFixupFormatTypar g m tp = - let _,_,tinst = FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] [tp] + let _,_,tinst = FreshenAndFixupTypars g traitCtxtNone m TyparRigidity.Flexible [] [] [tp] List.head tinst let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 2767cca37de..198b28a9565 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -60,7 +60,7 @@ let UnifyRefTupleType contextInfo (cenv: cenv) denv m ty ps = let rec TryAdjustHiddenVarNameToCompGenName cenv env (id: Ident) altNameRefCellOpt = match altNameRefCellOpt with | Some ({contents = SynSimplePatAlternativeIdInfo.Undecided altId } as altNameRefCell) -> - match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.eNameResEnv TypeNameResolutionInfo.Default [id] with + match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false id.idRange env.eAccessRights env.TraitContext env.eNameResEnv TypeNameResolutionInfo.Default [id] with | Item.NewDef _ -> // The name is not in scope as a pattern identifier (e.g. union case), so do not use the alternate ID None @@ -495,7 +495,7 @@ and IsNameOf (cenv: cenv) (env: TcEnv) ad m (id: Ident) = let g = cenv.g id.idText = "nameof" && try - match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.NameEnv TypeNameResolutionInfo.Default [id] with + match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.TraitContext env.NameEnv TypeNameResolutionInfo.Default [id] with | Result (_, Item.Value vref, _) -> valRefEq g vref g.nameof_vref | _ -> false with _ -> false @@ -513,7 +513,7 @@ and TcPatLongIdent warnOnUpper cenv env ad valReprInfo vFlags (patEnv: TcPatLine let mLongId = rangeOfLid longId - match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperForId false m ad env.NameEnv TypeNameResolutionInfo.Default longId with + match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperForId false m ad env.TraitContext env.NameEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> TcPatLongIdentNewDef warnOnUpperForId warnOnUpper cenv env ad valReprInfo vFlags patEnv ty (vis, id, args, m) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 751e71bff5c..5b1fe635312 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -57,6 +57,7 @@ open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls +open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps @@ -121,31 +122,26 @@ let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) -// QUERY: should 'rigid' ever really be 'true'? We set this when we know -// we are going to have to generalize a typar, e.g. when implementing a -// abstract generic method slot. But we later check the generalization -// condition anyway, so we could get away with a non-rigid typar. This -// would sort of be cleaner, though give errors later. -let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = +let FreshenAndFixupTypars (g: TcGlobals) (traitCtxt: ITraitContext option) m rigid fctps tinst tpsorig = let tps = tpsorig |> List.map (FreshenTypar g rigid) - let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps + let renaming, tinst = FixupNewTypars traitCtxt m fctps tinst tpsorig tps tps, renaming, tinst -let FreshenTypeInst g m tpsorig = - FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig +let FreshenTypeInst g traitCtxt m tpsorig = + FreshenAndFixupTypars g traitCtxt m TyparRigidity.Flexible [] [] tpsorig -let FreshMethInst g m fctps tinst tpsorig = - FreshenAndFixupTypars g m TyparRigidity.Flexible fctps tinst tpsorig +let FreshMethInst g traitCtxt m fctps tinst tpsorig = + FreshenAndFixupTypars g traitCtxt m TyparRigidity.Flexible fctps tinst tpsorig -let FreshenTypars g m tpsorig = +let FreshenTypars g traitCtxt m tpsorig = match tpsorig with | [] -> [] | _ -> - let _, _, tpTys = FreshenTypeInst g m tpsorig + let _, _, tpTys = FreshenTypeInst g traitCtxt m tpsorig tpTys -let FreshenMethInfo m (minfo: MethInfo) = - let _, _, tpTys = FreshMethInst minfo.TcGlobals m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars +let FreshenMethInfo g traitCtxt m (minfo: MethInfo) = + let _, _, tpTys = FreshMethInst g traitCtxt m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars tpTys //------------------------------------------------------------------------- @@ -388,9 +384,44 @@ let rec occursCheck g un ty = /// During code gen we run with permitWeakResolution on, but we only apply it where one of the argument types for the built-in constraint resolution is /// a variable type. type PermitWeakResolution = - | Yes + + /// Represents the point where we are generalizing inline code + | YesAtInlineGeneralization + + /// Represents points where we are choosing a default solution to trait constraints + | YesAtChooseSolution + + /// Represents invocations of the constraint solver during codegen or inlining to determine witnesses + | YesAtCodeGen + + /// No weak resolution allowed | No - member x.Permit = match x with Yes -> true | No -> false + + /// Determine if the weak resolution flag means we perform overload resolution + /// based on weak information. + member x.Permit (g: TcGlobals) = + if g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions then + match x with + | YesAtChooseSolution -> true + | YesAtCodeGen + | YesAtInlineGeneralization + | No -> false + else + //legacy + match x with + | YesAtChooseSolution + | YesAtCodeGen + | YesAtInlineGeneralization -> true + | No -> false + +// Get measure of type, float<_> or float32<_> or decimal<_> but not float=float<1> or float32=float32<1> or decimal=decimal<1> +let GetMeasureOfType g ty = + match ty with + | AppTy g (tcref, [tyarg]) -> + match stripTyEqns g tyarg with + | TType_measure ms when not (measureEquiv g ms Measure.One) -> Some (tcref, ms) + | _ -> None + | _ -> None let rec isNativeIntegerTy g ty = typeEquivAux EraseMeasures g g.nativeint_ty ty || @@ -435,10 +466,29 @@ let isFpTy g ty = let isDecimalTy g ty = typeEquivAux EraseMeasures g g.decimal_ty ty +// int*, int*<_> float*, float<_>*, enums +// +// Addition is supported on these via built-in resolution. Note even on enums, so +// System.DayOfWeek.Monday + System.DayOfWeek.Tuesday +// is allowed let IsNonDecimalNumericOrIntegralEnumType g ty = IsIntegerOrIntegerEnumTy g ty || isFpTy g ty +// int*, int*<_> float*, float<_>*, enums, decimal, decimal<_> +// +// This is used for one side of multiplication supported via built-in resolution let IsNumericOrIntegralEnumType g ty = IsNonDecimalNumericOrIntegralEnumType g ty || isDecimalTy g ty +// decimal<_> but not decimal +let IsUnitizedDecimalType g ty = + Option.isSome (GetMeasureOfType g ty) && isDecimalTy g ty + +// int*, int*<_> float*, float<_>*, enums, decimal<_> but NOT plain decimal +// +// This is used for other side of multiplication supported via built-in resolution + +let IsNonDecimalNumericOrIntegralEnumOrUnitizedDecimalType g ty = + IsNonDecimalNumericOrIntegralEnumType g ty || IsUnitizedDecimalType g ty + let IsNonDecimalNumericType g ty = isIntegerTy g ty || isFpTy g ty let IsNumericType g ty = IsNonDecimalNumericType g ty || isDecimalTy g ty @@ -448,21 +498,137 @@ let IsRelationalType g ty = IsNumericType g ty || isStringTy g ty || isCharTy g let IsCharOrStringType g ty = isCharTy g ty || isStringTy g ty /// Checks the argument type for a built-in solution to an op_Addition, op_Subtraction or op_Modulus constraint. -let IsAddSubModType nm g ty = IsNumericOrIntegralEnumType g ty || (nm = "op_Addition" && IsCharOrStringType g ty) || (nm = "op_Subtraction" && isCharTy g ty) +let IsAddSubModType nm g ty = + IsNonDecimalNumericOrIntegralEnumOrUnitizedDecimalType g ty || (nm = "op_Addition" && IsCharOrStringType g ty) || (nm = "op_Subtraction" && isCharTy g ty) /// Checks the argument type for a built-in solution to a bitwise operator constraint let IsBitwiseOpType g ty = IsIntegerOrIntegerEnumTy g ty || (isEnumTy g ty) -/// Check the other type in a built-in solution for a binary operator. -/// For weak resolution, require a relevant primitive on one side. -/// For strong resolution, a variable type is permitted. -let IsBinaryOpOtherArgType g permitWeakResolution ty = +// For weak resolution, require a relevant primitive on one side +// For strong resolution +// - if there are relevant methods require an exact primitive on the other side. +// - if there are no relevant methods just require a non-variable type on the other side. +let IsBinaryOpArgTypePair p1 p2 permitWeakResolution minfos g ty1 ty2 = + p1 ty1 && + match permitWeakResolution with + // During regular inference we apply a builtin resolution if either there are no relevant methods to solve traits (and the type is nominal), or if + // there are relevant methods we check that the type is precisely correct | PermitWeakResolution.No -> - not (isTyparTy g ty) + if isNil minfos then + // compat path + not (isTyparTy g ty2) && + // All built-in rules only apply in cases where left and right operator types are equal (after + // erasing units) + typeEquivAux EraseMeasures g ty1 ty2 + else + // normal path - for builtin binary op solutions we check the underlying types are equivalent + p2 ty2 && + // all built-in rules only apply in cases where left and right operator types are equal (after + // erasing units) + typeEquivAux EraseMeasures g ty1 ty2 + + // During regular canonicalization we don't do any check on the other type at all - we + // ignore the possibility that method overloads may resolve the constraint + | PermitWeakResolution.YesAtInlineGeneralization + | PermitWeakResolution.YesAtChooseSolution -> + // weak resolution lets the other type be a variable type + isTyparTy g ty2 || + // If the other type is not a variable type, it is nominal, + // and all built-in rules only apply in cases where left and right operator types are equal (after + // erasing units) + typeEquivAux EraseMeasures g ty1 ty2 + + // During codegen we only apply a builtin resolution if both the types are correct + | PermitWeakResolution.YesAtCodeGen -> + p2 ty2 && + // All built-in rules only apply in cases where left and right operator types are equal (after + // erasing units) + typeEquivAux EraseMeasures g ty1 ty2 + +let IsSymmetricBinaryOpArgTypePair p permitWeakResolution minfos g ty1 ty2 = + IsBinaryOpArgTypePair p p permitWeakResolution minfos g ty1 ty2 || + IsBinaryOpArgTypePair p p permitWeakResolution minfos g ty2 ty1 + +/// Checks if the knowledge we have of the argument types is enough to commit to a path that simulates that a +/// type supports the op_Addition, op_Subtraction or op_Modulus static members +let IsAddSubModTypePair nm permitWeakResolution minfos g ty1 ty2 = + IsSymmetricBinaryOpArgTypePair (IsAddSubModType nm g) permitWeakResolution minfos g ty1 ty2 + +/// Checks if the knowledge we have of the argument types is enough to commit to a path that simulates that +/// a type supports the op_LessThan, op_LessThanOrEqual, op_GreaterThan, op_GreaterThanOrEqual, op_Equality or op_Inequality static members +let IsRelationalOpArgTypePair permitWeakResolution minfos g ty1 ty2 = + IsSymmetricBinaryOpArgTypePair (IsRelationalType g) permitWeakResolution minfos g ty1 ty2 + +/// Checks if the knowledge we have of the argument types is enough to commit to a path that simulates that +/// a type supports the op_BitwiseAnd, op_BitwiseOr or op_ExclusiveOr static members +let IsBitwiseOpArgTypePair permitWeakResolution minfos g ty1 ty2 = + IsSymmetricBinaryOpArgTypePair (IsBitwiseOpType g) permitWeakResolution minfos g ty1 ty2 + +// So +// decimal<_> * decimal<_> +// decimal<_> * decimal +// decimal * decimal<_> +// are supported via built-in resolution, but +// decimal * decimal +// is not since there is an op_Multiply call available for that. +// +// Note +// System.DayOfWeek.Monday * System.DayOfWeek.Tuesday +// is allowed for enums, somewhat weirdly but that's how it is +// +let IsMulDivTypeArgPairOneWay permitWeakResolution minfos g ty1 ty2 = + IsBinaryOpArgTypePair + (IsNumericOrIntegralEnumType g) + (IsNonDecimalNumericOrIntegralEnumOrUnitizedDecimalType g) + permitWeakResolution + minfos + g + ty1 ty2 + +let IsMulDivTypeArgPair permitWeakResolution minfos g ty1 ty2 = + IsMulDivTypeArgPairOneWay permitWeakResolution minfos g ty1 ty2 || + IsMulDivTypeArgPairOneWay permitWeakResolution minfos g ty2 ty1 - | PermitWeakResolution.Yes -> true +(* TODO: factor this back in + // This simulates the existence of + // float * float -> float + // float32 * float32 -> float32 + // float<'u> * float<'v> -> float<'u 'v> + // float32<'u> * float32<'v> -> float32<'u 'v> + // decimal<'u> * decimal<'v> -> decimal<'u 'v> + // decimal<'u> * decimal -> decimal<'u> + // float32<'u> * float32<'v> -> float32<'u 'v> + // int * int -> int + // int64 * int64 -> int64 + // + // The rule is triggered by these sorts of inputs when permitWeakResolution=false + // float * float + // float * float32 // will give error + // decimal * decimal + // decimal * decimal <-- Note this one triggers even though "decimal" has some possibly-relevant methods + // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead + // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead + // + // The rule is triggered by these sorts of inputs when permitWeakResolution=true + // float * 'a + // 'a * float + // decimal<'u> * 'a + (let checkRuleAppliesInPreferenceToMethods argTy1 argTy2 = + // Check that at least one of the argument types is numeric + IsNumericOrIntegralEnumType g argTy1 && + // Check the other type is nominal, unless using weak resolution + IsBinaryOpOtherArgType g permitWeakResolution argTy2 && + // This next condition checks that either + // - Neither type contributes any methods OR + // - We have the special case "decimal<_> * decimal". In this case we have some + // possibly-relevant methods from "decimal" but we ignore them in this case. + (isNil minfos || (Option.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in + + checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || + checkRuleAppliesInPreferenceToMethods argTy2 argTy1) -> +*) /// Checks the argument type for a built-in solution to a get_Sign constraint. let IsSignType g ty = isSignedIntegerTy g ty || isFpTy g ty || isDecimalTy g ty @@ -1384,7 +1550,14 @@ and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty /// /// 2. Some additional solutions are forced prior to generalization (permitWeakResolution= Yes or YesDuringCodeGen). See above and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace traitInfo : OperationResult = trackErrors { - let (TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo + let (TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln, traitCtxt)) = traitInfo + + // Work out the relevant accessibility domain for the trait + let traitAD = + match traitCtxt with + | None -> AccessorDomain.AccessibleFromEverywhere + | Some c -> (c.AccessRights :?> AccessorDomain) + // Do not re-solve if already solved if sln.Value.IsSome then return true else @@ -1401,7 +1574,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let supportTys = ListSet.setify (typeAEquiv g aenv) supportTys // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln) + let traitInfo = TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln, traitCtxt) let retTy = GetFSharpViewOfReturnType g retTy // Assert the object type if the constraint is for an instance member @@ -1432,45 +1605,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let! res = trackErrors { - match minfos, supportTys, memFlags.IsInstance, nm, argTys with - | _, _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2] - when - // This simulates the existence of - // float * float -> float - // float32 * float32 -> float32 - // float<'u> * float<'v> -> float<'u 'v> - // float32<'u> * float32<'v> -> float32<'u 'v> - // decimal<'u> * decimal<'v> -> decimal<'u 'v> - // decimal<'u> * decimal -> decimal<'u> - // float32<'u> * float32<'v> -> float32<'u 'v> - // int * int -> int - // int64 * int64 -> int64 - // - // The rule is triggered by these sorts of inputs when permitWeakResolution=false - // float * float - // float * float32 // will give error - // decimal * decimal - // decimal * decimal <-- Note this one triggers even though "decimal" has some possibly-relevant methods - // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead - // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead - // - // The rule is triggered by these sorts of inputs when permitWeakResolution=true - // float * 'a - // 'a * float - // decimal<'u> * 'a - (let checkRuleAppliesInPreferenceToMethods argTy1 argTy2 = - // Check that at least one of the argument types is numeric - IsNumericOrIntegralEnumType g argTy1 && - // Check the other type is nominal, unless using weak resolution - IsBinaryOpOtherArgType g permitWeakResolution argTy2 && - // This next condition checks that either - // - Neither type contributes any methods OR - // - We have the special case "decimal<_> * decimal". In this case we have some - // possibly-relevant methods from "decimal" but we ignore them in this case. - (isNil minfos || (Option.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in - - checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || - checkRuleAppliesInPreferenceToMethods argTy2 argTy1) -> + match supportTys, memFlags.IsInstance, nm, argTys with + | _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2] + when IsMulDivTypeArgPair permitWeakResolution minfos g argTy1 argTy2 -> match getMeasureOfType g argTy1 with | Some (tcref, ms1) -> @@ -1494,52 +1631,48 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn - | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argTy1;argTy2] - when // Ignore any explicit +/- overloads from any basic integral types - (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( IsAddSubModType nm g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsAddSubModType nm g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> + | _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argTy1;argTy2] + when IsAddSubModTypePair nm permitWeakResolution minfos g argTy1 argTy2 -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn - | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argTy1;argTy2] - when // Ignore any explicit overloads from any basic integral types - (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( IsRelationalType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsRelationalType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> + | _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argTy1;argTy2] + when IsRelationalOpArgTypePair permitWeakResolution minfos g argTy1 argTy2 -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.bool_ty return TTraitBuiltIn // We pretend for uniformity that the numeric types have a static property called Zero and One // As with constants, only zero is polymorphic in its units - | [], [ty], false, "get_Zero", [] + | [ty], false, "get_Zero", [] when IsNumericType g ty || isCharTy g ty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty return TTraitBuiltIn - | [], [ty], false, "get_One", [] + | [ty], false, "get_One", [] when IsNumericType g ty || isCharTy g ty -> do! SolveDimensionlessNumericType csenv ndeep m2 trace ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty return TTraitBuiltIn - | [], _, false, "DivideByInt", [argTy1;argTy2] + | _, false, "DivideByInt", [argTy1;argTy2] when isFpTy g argTy1 || isDecimalTy g argTy1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' - | [], [ty], true, "get_Item", [argTy1] + | [ty], true, "get_Item", [argTy1] when isStringTy g ty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.char_ty return TTraitBuiltIn - | [], [ty], true, "get_Item", argTys + | [ty], true, "get_Item", argTys when isArrayTy g ty -> if rankOfArrayTy g ty <> argTys.Length then @@ -1552,7 +1685,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ety return TTraitBuiltIn - | [], [ty], true, "set_Item", argTys + | [ty], true, "set_Item", argTys when isArrayTy g ty -> if rankOfArrayTy g ty <> argTys.Length - 1 then @@ -1566,16 +1699,15 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace lastTy elemTy return TTraitBuiltIn - | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argTy1;argTy2] - when IsBitwiseOpType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsBitwiseOpType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1 -> + | _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argTy1;argTy2] + when IsBitwiseOpArgTypePair permitWeakResolution minfos g argTy1 argTy1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 return TTraitBuiltIn - | [], _, false, ("op_LeftShift" | "op_RightShift"), [argTy1;argTy2] + | _, false, ("op_LeftShift" | "op_RightShift"), [argTy1;argTy2] when IsIntegerOrIntegerEnumTy g argTy1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty @@ -1583,38 +1715,38 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 return TTraitBuiltIn - | _, _, false, "op_UnaryPlus", [argTy] + | _, false, "op_UnaryPlus", [argTy] when IsNumericOrIntegralEnumType g argTy -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy return TTraitBuiltIn - | _, _, false, "op_UnaryNegation", [argTy] + | _, false, "op_UnaryNegation", [argTy] when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy return TTraitBuiltIn - | _, _, true, "get_Sign", [] - when IsSignType g supportTys.Head -> + | _, true, "get_Sign", [] + when IsSignType g supportTys.Head -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.int32_ty return TTraitBuiltIn - | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argTy] + | _, false, ("op_LogicalNot" | "op_OnesComplement"), [argTy] when IsIntegerOrIntegerEnumTy g argTy -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy return TTraitBuiltIn - | _, _, false, "Abs", [argTy] + | _, false, "Abs", [argTy] when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy return TTraitBuiltIn - | _, _, false, "Sqrt", [argTy1] + | _, false, "Sqrt", [argTy1] when isFpTy g argTy1 -> match getMeasureOfType g argTy1 with | Some (tcref, _) -> @@ -1626,7 +1758,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn - | _, _, false, ("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"), [argTy] + | _, false, ("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"), [argTy] when isFpTy g argTy -> do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy @@ -1634,7 +1766,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn // Conversions from non-decimal numbers / strings / chars to non-decimal numbers / chars are built-in - | _, _, false, "op_Explicit", [argTy] + | _, false, "op_Explicit", [argTy] when (// The input type. (IsNonDecimalNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && // The output type @@ -1643,32 +1775,33 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn // Conversions from (including decimal) numbers / strings / chars to decimals are built-in - | _, _, false, "op_Explicit", [argTy] - when (// The input type. + | _, false, "op_Explicit", [argTy] + when (// The input type. (IsNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && // The output type (isDecimalTy g retTy)) -> return TTraitBuiltIn // Conversions from decimal numbers to native integers are built-in - // The rest of decimal conversions are handled via op_Explicit lookup on System.Decimal (which also looks for op_Implicit) - | _, _, false, "op_Explicit", [argTy] + // The rest of decimal conversions are handled via op_Explicit/op_Implicit lookup on System.Decimal + | _, false, "op_Explicit", [argTy] when (// The input type. (isDecimalTy g argTy) && // The output type (isNativeIntegerTy g retTy)) -> return TTraitBuiltIn - | [], _, false, "Pow", [argTy1; argTy2] + | _, false, "Pow", [argTy1; argTy2] when isFpTy g argTy1 -> do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn - | _, _, false, "Atan2", [argTy1; argTy2] + | _, false, "Atan2", [argTy1; argTy2] when isFpTy g argTy1 -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 match getMeasureOfType g argTy1 with | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 @@ -1687,11 +1820,11 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let propName = nm[4..] let props = supportTys |> List.choose (fun ty -> - match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with + match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, traitAD, false) FindMemberFlag.IgnoreOverrides m ty with | Some (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && (rfinfo.IsStatic = not memFlags.IsInstance) && - IsRecdFieldAccessible amap m AccessibleFromEverywhere rfinfo.RecdFieldRef && + IsRecdFieldAccessible amap m traitAD rfinfo.RecdFieldRef && not rfinfo.LiteralValue.IsSome && not rfinfo.RecdField.IsCompilerGenerated -> Some (rfinfo, isSetProp) @@ -1758,14 +1891,14 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let callerArgs = { Unnamed = [ (argTys |> List.map (fun argTy -> CallerArg(argTy, m, false, dummyExpr))) ] Named = [ [ ] ] } - let minst = FreshenMethInfo m minfo + let minst = FreshenMethInfo g traitCtxt m minfo let objtys = minfo.GetObjArgTypes(amap, m, minst) - Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) + Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo g traitCtxt, m, traitAD, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) let methOverloadResult, errors = trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a) - (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty AccessibleFromEverywhere calledMethGroup false (Some (MustEqual retTy))) + (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty traitAD calledMethGroup false (Some (MustEqual retTy))) match anonRecdPropSearch, recdPropSearch, methOverloadResult with | Some (anonInfo, tinst, i), None, None -> @@ -1822,7 +1955,7 @@ and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignore // If there's nothing left to learn then raise the errors. // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability // reasons we use the more restrictive isNil frees. - if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then + if (permitWeakResolution.Permit(g) && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then do! errors // Otherwise re-record the trait waiting for canonicalization else @@ -1846,8 +1979,8 @@ and RecordMemberConstraintSolution css m trace traitInfo traitConstraintSln = | TTraitUnsolved -> ResultD false - | TTraitSolved (minfo, minst, staticTyOpt) -> - let sln = MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt + | TTraitSolved (minfo, minst, staticTyOpt) -> + let sln = MemberConstraintSolutionOfMethInfo css m traitInfo.TraitContext minfo minst staticTyOpt TransactMemberConstraintSolution traitInfo trace sln ResultD true @@ -1866,7 +1999,7 @@ and RecordMemberConstraintSolution css m trace traitInfo traitConstraintSln = ResultD true /// Convert a MethInfo into the data we save in the TAST -and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt = +and MemberConstraintSolutionOfMethInfo css m traitCtxt minfo minst staticTyOpt = #if !NO_TYPEPROVIDERS #else // to prevent unused parameter warning @@ -1878,8 +2011,8 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt = let iltref = ilMeth.ILExtensionMethodDeclaringTyconRef |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst, staticTyOpt) - | FSMeth(_, ty, vref, _) -> - FSMethSln(ty, vref, minst, staticTyOpt) + | FSMeth(_, ty, vref, extInfo) -> + FSMethSln(ty, vref, minst, staticTyOpt, extInfo.IsSome) | MethInfo.DefaultStructCtor _ -> error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) @@ -1890,7 +2023,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt = let minst = [] // GENERIC TYPE PROVIDERS: for generics, we would have an minst here let allArgVars, allArgs = minfo.GetParamTypes(amap, m, minst) |> List.concat |> List.mapi (fun i ty -> mkLocal m ("arg"+string i) ty) |> List.unzip let objArgVars, objArgs = (if minfo.IsInstance then [mkLocal m "this" minfo.ApparentEnclosingType] else []) |> List.unzip - let callMethInfoOpt, callExpr, callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) + let callMethInfoOpt, callExpr, callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, traitCtxt, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) let closedExprSln = ClosedExprSln (mkLambdas g m [] (objArgVars@allArgVars) (callExpr, callExprTy) ) // If the call is a simple call to an IL method with all the arguments in the natural order, then revert to use ILMethSln. @@ -1915,12 +2048,22 @@ and TransactMemberConstraintSolution traitInfo (trace: OptionalTrace) sln = let prev = traitInfo.Solution trace.Exec (fun () -> traitInfo.Solution <- Some sln) (fun () -> traitInfo.Solution <- prev) +and GetRelevantExtensionMethodsForTrait m (infoReader: InfoReader) (traitInfo: TraitConstraintInfo) = + [ + match traitInfo.TraitContext with + | None -> () + | Some traitCtxt -> + for (supportTy, extMethInfo) in traitCtxt.SelectExtensionMethods(traitInfo, m, infoReader=infoReader) do + supportTy, (extMethInfo :?> MethInfo) + ] + /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm traitInfo : (TType * MethInfo) list = - let (TTrait(_, _, memFlags, _, _, _)) = traitInfo + let g = csenv.g + let (TTrait(_, _, memFlags, _, _, _, _)) = traitInfo let results = - if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then + if permitWeakResolution.Permit g || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m let nominalTys = GetNominalSupportOfMemberConstraint csenv nm traitInfo @@ -1938,8 +2081,19 @@ and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolutio // Merge the sets so we don't get the same minfo from each side // We merge based on whether minfos use identical metadata or not. - let minfos = ListSet.setify (fun (_,minfo1) (_, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) minfos + let minfos = minfos |> ListSet.setify (fun (_,minfo1) (_, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) + // Get the extension method that may be relevant to solving the constraint as MethInfo objects. + // Extension members are not used when canonicalizing prior to generalization (permitWeakResolution=true) + let extMethInfos = + if MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then + GetRelevantExtensionMethodsForTrait csenv.m csenv.InfoReader traitInfo + else [] + + let extMethInfos = extMethInfos |> ListSet.setify (fun (_,minfo1) (_, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) + + let minfos = minfos @ extMethInfos + /// Check that the available members aren't hiding a member from the parent (depth 1 only) let relevantMinfos = minfos |> List.filter(fun (_, minfo) -> not minfo.IsDispatchSlot && not minfo.IsVirtual && minfo.IsInstance) minfos @@ -1952,8 +2106,8 @@ and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolutio // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then - let (TTrait(supportTys, _, memFlags, argTys, retTy, soln)) = traitInfo - let traitInfo2 = TTrait(supportTys, "op_Implicit", memFlags, argTys, retTy, soln) + let (TTrait(supportTys, _, memFlags, argTys, retTy, soln, traitCtxt)) = traitInfo + let traitInfo2 = TTrait(supportTys, "op_Implicit", memFlags, argTys, retTy, soln, traitCtxt) results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" traitInfo2 else results @@ -2010,7 +2164,7 @@ and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInf /// Get all the unsolved typars (statically resolved or not) relevant to the member constraint and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) traitInfo = - let (TTrait(supportTys, _, _, argTys, retTy, _)) = traitInfo + let (TTrait(supportTys, _, _, argTys, retTy, _, _)) = traitInfo freeInTypesLeftToRightSkippingConstraints csenv.g (supportTys @ argTys @ Option.toList retTy) and MemberConstraintIsReadyForWeakResolution csenv traitInfo = @@ -2048,7 +2202,7 @@ and SolveRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep permitWeak | ValueNone -> ResultD false)) -and SolveRelevantMemberConstraintsForTypar (csenv: ConstraintSolverEnv) ndeep permitWeakResolution (trace: OptionalTrace) tp = +and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep (permitWeakResolution: PermitWeakResolution) (trace:OptionalTrace) tp = let cxst = csenv.SolverState.ExtraCxs let tpn = tp.Stamp let cxs = cxst.FindAll tpn @@ -2062,8 +2216,10 @@ and SolveRelevantMemberConstraintsForTypar (csenv: ConstraintSolverEnv) ndeep pe let csenv = { csenv with m = m2 } SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo) -and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps = - SolveRelevantMemberConstraints csenv ndeep PermitWeakResolution.Yes trace tps +and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps (isInline: bool) = + ignore isInline + let permitWeakResolution = (if isInline then PermitWeakResolution.YesAtInlineGeneralization else PermitWeakResolution.YesAtChooseSolution) + SolveRelevantMemberConstraints csenv ndeep permitWeakResolution trace tps and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) traitInfo support (frees: Typar list) = let g = csenv.g @@ -2080,7 +2236,7 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr let cxs = cxst.FindAll tpn // check the constraint is not already listed for this type variable - if not (cxs |> List.exists (fun (traitInfo2, _) -> traitsAEquiv g aenv traitInfo traitInfo2)) then + if not (cxs |> List.exists (fun (traitInfo2, _valRefs) -> traitsAEquiv g aenv traitInfo traitInfo2)) then trace.Exec (fun () -> csenv.SolverState.ExtraCxs.Add (tpn, (traitInfo, m2))) (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) ) @@ -2094,8 +2250,8 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr and TraitsAreRelated (csenv: ConstraintSolverEnv) retry traitInfo1 traitInfo2 = let g = csenv.g - let (TTrait(tys1, nm1, memFlags1, argTys1, _, _)) = traitInfo1 - let (TTrait(tys2, nm2, memFlags2, argTys2, _, _)) = traitInfo2 + let (TTrait(tys1, nm1, memFlags1, argTys1, _, _, _)) = traitInfo1 + let (TTrait(tys2, nm2, memFlags2, argTys2, _, _, _)) = traitInfo2 memFlags1.IsInstance = memFlags2.IsInstance && nm1 = nm2 && // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. @@ -2120,8 +2276,8 @@ and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace ret match tpc1, tpc2 with | TyparConstraint.MayResolveMember(traitInfo1, _), TyparConstraint.MayResolveMember(traitInfo2, _) when TraitsAreRelated csenv retry traitInfo1 traitInfo2 -> - let (TTrait(tys1, _, _, argTys1, rty1, _)) = traitInfo1 - let (TTrait(tys2, _, _, argTys2, rty2, _)) = traitInfo2 + let (TTrait(tys1, _, _, argTys1, rty1, _, _)) = traitInfo1 + let (TTrait(tys2, _, _, argTys2, rty2, _, _)) = traitInfo2 if retry then match tys1, tys2 with | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 @@ -2956,7 +3112,7 @@ and AssumeMethodSolvesTrait (csenv: ConstraintSolverEnv) (cx: TraitConstraintInf match cx with | Some traitInfo when traitInfo.Solution.IsNone -> let staticTyOpt = if calledMeth.Method.IsInstance then None else calledMeth.OptionalStaticType - let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs staticTyOpt + let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m traitInfo.TraitContext calledMeth.Method calledMeth.CalledTyArgs staticTyOpt #if TRAIT_CONSTRAINT_CORRECTIONS if csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections then TransactMemberConstraintSolution traitInfo trace traitSln @@ -3015,7 +3171,10 @@ and ResolveOverloading /// -- if TraitConstraintCorrections is enabled, also check return types for SRTP constraints let alwaysCheckReturn = isOpConversion || - candidates |> List.exists (fun cmeth -> cmeth.HasOutArgs) + candidates |> List.exists (fun cmeth -> + cmeth.HasOutArgs || + (g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions && + AttributeChecking.MethInfoHasAttribute g m g.attrib_AllowOverloadByReturnTypeAttribute cmeth.Method)) #if TRAIT_CONSTRAINT_CORRECTIONS || (csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections && cx.IsSome) #endif @@ -3036,7 +3195,7 @@ and ResolveOverloading (TypesMustSubsume csenv ndeep (WithTrace newTrace) cxsln m) // obj can subsume (ReturnTypesMustSubsumeOrConvert csenv ad ndeep (WithTrace newTrace) cxsln cx.IsSome m) // return can subsume or convert (ArgsEquivOrConvert csenv ad ndeep (WithTrace newTrace) cxsln cx.IsSome) // args exact - reqdRetTyOpt + reqdRetTyOpt calledMeth) match exactMatchCandidates with @@ -3050,6 +3209,7 @@ and ResolveOverloading candidates |> FilterEachThenUndo (fun newTrace candidate -> let csenv = { csenv with IsSpeculativeForMethodOverloading = true } let cxsln = AssumeMethodSolvesTrait csenv cx m (WithTrace newTrace) candidate + //let cxsln = cx |> Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m traitInfo.TraitContext candidate.Method candidate.CalledTyArgs)) CanMemberSigsMatchUpToCheck csenv permitOptArgs @@ -3639,45 +3799,6 @@ let CreateCodegenState tcVal g amap = PostInferenceChecksPreDefaults = ResizeArray() PostInferenceChecksFinal = ResizeArray() } -/// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code -let CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs tcVal g amap m (traitInfo:TraitConstraintInfo) = trackErrors { - let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo - let res = - match traitInfo.Solution with - | None - | Some BuiltInSln -> true - | _ -> false - return res - } - -/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code -let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { - let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo - return GenWitnessExpr amap g m traitInfo argExprs - } - -/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses -let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { - let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let ftps, _renaming, tinst = FreshenTypeInst g m typars - let traitInfos = GetTraitConstraintInfosOfTypars g ftps - do! SolveTyparsEqualTypes csenv 0 m NoTrace tinst tyargs - return GenWitnessArgs amap g m traitInfos - } - -/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses -let CodegenWitnessArgForTraitConstraint tcVal g amap m traitInfo = trackErrors { - let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo - return GenWitnessExprLambda amap g m traitInfo - } - /// For some code like "let f() = ([] = [])", a free choice is made for a type parameter /// for an interior type variable. This chooses a solution for a type parameter subject /// to its constraints and applies that solution by using a constraint. @@ -3703,19 +3824,115 @@ let CheckDeclaredTypars denv css m typars1 typars2 = ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult -let CanonicalizePartialInferenceProblem css denv m tps = +let CanonicalizePartialInferenceProblem css denv m tps isInline = // Canonicalize constraints prior to generalization let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } IgnoreFailedMemberConstraintResolution - (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) + (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps isInline) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult +/// Apply defaults arising from 'default' constraints in FSharp.Core +/// for any unsolved free inference type variables. +/// Defaults get applied before the module signature is checked and before the implementation conditions on virtuals/overrides. +/// Defaults get applied in priority order. Defaults listed last get priority 0 (lowest), 2nd last priority 1 etc. +let ApplyDefaultsForUnsolved css denv (unsolved: Typar list) = + + // The priority order comes from the order of declaration of the defaults in FSharp.Core. + for priority = 10 downto 0 do + for tp in unsolved do + 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 denv css priority tp + + // OK, now apply defaults for any unsolved HeadTypeStaticReq + for tp in unsolved do + if not tp.IsSolved then + if tp.StaticReq <> TyparStaticReq.None then + ChooseTyparSolutionAndSolve css denv tp + +/// Choose solutions for any remaining unsolved free inference type variables. +let ChooseSolutionsForUnsolved css denv (unsolved: Typar list) = + for tp in unsolved do + if (tp.Rigidity <> TyparRigidity.Rigid) && not tp.IsSolved then + ChooseTyparSolutionAndSolve css denv tp + +let ApplyDefaultsAfterWitnessGeneration (g: TcGlobals) amap css denv sln = + // The process of generating witnesses can cause free inference type variables to arise from use + // of generic methods as extension constraint solutions. We eliminate these using the same + // sequence (ApplyDefault, ChooseSolutions) used at the end of type inference. + if g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions then + sln |> Option.iter (fun slnExpr -> + // Apply all defaults + let unsolved = FindUnsolved.UnsolvedTyparsOfExpr g amap denv slnExpr + ApplyDefaultsForUnsolved css denv unsolved + + // Search again and choose solutions + let unsolved2 = FindUnsolved.UnsolvedTyparsOfExpr g amap denv slnExpr + ChooseSolutionsForUnsolved css denv unsolved2) + +/// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code +let CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs tcVal g amap m (traitInfo:TraitConstraintInfo) = trackErrors { + let css = CreateCodegenState tcVal g amap + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.YesAtCodeGen 0 m NoTrace traitInfo + let res = + match traitInfo.Solution with + | None + | Some BuiltInSln -> true + | _ -> false + return res + } +/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code +let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { + let css = CreateCodegenState tcVal g amap + let denv = DisplayEnv.Empty g + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.YesAtCodeGen 0 m NoTrace traitInfo + let sln = GenWitnessExpr amap g m traitInfo argExprs + ApplyDefaultsAfterWitnessGeneration g amap css denv sln + return sln + } + +/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses +let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { + let css = CreateCodegenState tcVal g amap + let denv = DisplayEnv.Empty g + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + // TODO: check traitCtxtNone here, feels wrong. We should simply not be re-freshening here during codegen. + // This is invoked every time codegen or quotation calls a witness-accepting + // method. TBH the witnesses need to be generated during type checking and passed all the way down, + // or at least be left in the tree as WitnessArg nodes. + let ftps, _renaming, tinst = FreshenTypeInst g traitCtxtNone m typars + let traitInfos = GetTraitConstraintInfosOfTypars g ftps + do! SolveTyparsEqualTypes csenv 0 m NoTrace tinst tyargs + let witnessArgs = GenWitnessArgs amap g m traitInfos + for witnessArg in witnessArgs do + match witnessArg with + | Choice1Of2 _traitInfo -> () + | Choice2Of2 sln -> ApplyDefaultsAfterWitnessGeneration g amap css denv (Some sln) + return witnessArgs + } + +/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses +let CodegenWitnessArgForTraitConstraint tcVal g amap m traitInfo = trackErrors { + let css = CreateCodegenState tcVal g amap + let denv = DisplayEnv.Empty g + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.YesAtCodeGen 0 m NoTrace traitInfo + let witnessLambda = MethodCalls.GenWitnessExprLambda amap g m traitInfo + match witnessLambda with + | Choice1Of2 _traitInfo -> () + | Choice2Of2 sln -> ApplyDefaultsAfterWitnessGeneration g amap css denv (Some sln) + return witnessLambda + } + /// An approximation used during name resolution for intellisense to eliminate extension members which will not /// apply to a particular object argument. This is given as the isApplicableMeth argument to the partial name resolution /// functions in nameres.fs. -let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = +let IsApplicableMethApprox g amap m traitCtxt (minfo: MethInfo) availObjTy = // Prepare an instance of a constraint solver // If it's an instance method, then try to match the object argument against the required object argument if minfo.IsExtensionMember then @@ -3728,7 +3945,7 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = PostInferenceChecksPreDefaults = ResizeArray() PostInferenceChecksFinal = ResizeArray() } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let minst = FreshenMethInfo m minfo + let minst = FreshenMethInfo g traitCtxt m minfo match minfo.GetObjArgTypes(amap, m, minst) with | [reqdObjTy] -> let reqdObjTy = if isByrefTy g reqdObjTy then destByrefTy g reqdObjTy else reqdObjTy // This is to support byref extension methods. diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index d6cc309c6b5..33a49d5e418 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -9,6 +9,7 @@ open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.MethodCalls +open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -42,6 +43,7 @@ val NewInferenceTypes: TcGlobals -> 'T list -> TType list /// 3. the inference type variables as a list of types. val FreshenAndFixupTypars: g: TcGlobals -> + ITraitContext option -> m: range -> rigid: TyparRigidity -> Typars -> @@ -56,21 +58,21 @@ val FreshenAndFixupTypars: /// 1. the new type parameters /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. -val FreshenTypeInst: g: TcGlobals -> range -> Typars -> Typars * TyparInstantiation * TType list +val FreshenTypeInst: g: TcGlobals -> ITraitContext option -> range -> Typars -> Typars * TyparInstantiation * TType list /// Given a set of type parameters, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted. /// /// Returns the inference type variables as a list of types. -val FreshenTypars: g: TcGlobals -> range -> Typars -> TType list +val FreshenTypars: g: TcGlobals -> ITraitContext option -> range -> Typars -> TType list /// Given a method, which may be generic, make new inference type variables for /// its generic parameters, and ensure that the constraints the new type variables are adjusted. /// /// Returns the inference type variables as a list of types. -val FreshenMethInfo: range -> MethInfo -> TType list +val FreshenMethInfo: g: TcGlobals -> ITraitContext option -> range -> MethInfo -> TType list -/// Information about the context of a type equation. +/// Information about the context of a type equation, for better error reporting [] type ContextInfo = @@ -353,6 +355,13 @@ val CodegenWitnessArgForTraitConstraint: /// to its constraints and applies that solution by using a constraint. val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> unit -val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool +/// Apply defaults arising from 'default' constraints in FSharp.Core +/// for any unsolved free inference type variables. +val ApplyDefaultsForUnsolved: ConstraintSolverState -> DisplayEnv -> Typar list -> unit -val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit +/// Choose solutions for any remaining unsolved free inference type variables. +val ChooseSolutionsForUnsolved: ConstraintSolverState -> DisplayEnv -> Typar list -> unit + +val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> ITraitContext option -> MethInfo -> TType -> bool + +val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> bool -> unit diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index 3a3b8c9de89..a2bb22c6b3f 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -156,7 +156,7 @@ and accOp cenv env (op, tyargs, args, _m) = accTypeInst cenv env retTys | _ -> () -and accTraitInfo cenv env (TTrait(tys, _nm, _, argTys, retTy, _sln)) = +and accTraitInfo cenv env (TTrait(tys, _nm, _, argTys, retTy, _sln, _traitCtxt)) = argTys |> accTypeInst cenv env retTy |> Option.iter (accTy cenv env) tys |> List.iter (accTy cenv env) @@ -290,4 +290,14 @@ let UnsolvedTyparsOfModuleDef g amap denv mdef extraAttribs = accAttribs cenv NoEnv extraAttribs List.rev cenv.unsolved +let UnsolvedTyparsOfExpr g amap denv expr = + let cenv = + { g =g + amap=amap + denv=denv + unsolved = [] + stackGuard = StackGuard(FindUnsolvedStackGuardDepth, "UnsolvedTyparsOfExpr") } + accExpr cenv NoEnv expr + List.rev cenv.unsolved + diff --git a/src/Compiler/Checking/FindUnsolved.fsi b/src/Compiler/Checking/FindUnsolved.fsi index 01d84c8807f..7aaf8878c10 100644 --- a/src/Compiler/Checking/FindUnsolved.fsi +++ b/src/Compiler/Checking/FindUnsolved.fsi @@ -15,3 +15,6 @@ val UnsolvedTyparsOfModuleDef: mdef: ModuleOrNamespaceContents -> extraAttribs: Attrib list -> Typar list + +/// Find all unsolved inference variables after adhoc generation of witness +val UnsolvedTyparsOfExpr: g: TcGlobals -> amap: ImportMap -> denv: DisplayEnv -> expr: Expr -> Typar list diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 1536277c506..67816b12443 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1022,11 +1022,11 @@ let BuildFSharpMethodApp g m (vref: ValRef) vExpr 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 vExpr = Expr.Val (vref, valUseFlags, m) let vExprTy = vref.Type let tpsorig, tau = vref.GeneralizedType - let vtinst = argsOfAppTy g ty @ minst + let vtinst = declaringTypeInst @ minst if tpsorig.Length <> vtinst.Length then error(InternalError("BuildFSharpMethodCall: unexpected List.length mismatch", m)) let expr = mkTyAppExpr m (vExpr, vExprTy) vtinst let exprTy = instType (mkTyparInst tpsorig vtinst) tau @@ -1052,8 +1052,8 @@ let MakeMethInfoCall (amap: ImportMap) m (minfo: MethInfo) minst args staticTyOp 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) @@ -1243,8 +1243,8 @@ let BuildObjCtorCall (g: TcGlobals) m = Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m) /// Implements the elaborated form of adhoc conversions from functions to delegates at member callsites -let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, delInvokeMeth: MethInfo, delArgTys, delFuncExpr, delFuncTy, m) = - let slotsig = delInvokeMeth.GetSlotSig(amap, m) +let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, traitCtxt, delegateTy, delInvokeMeth: MethInfo, delArgTys, delFuncExpr, delFuncTy, m) = + let slotsig = delInvokeMeth.GetSlotSig(amap, m, traitCtxt) let delArgVals, expr = let valReprInfo = ValReprInfo([], List.replicate (max 1 (List.length delArgTys)) ValReprInfo.unnamedTopArg, ValReprInfo.unnamedRetVal) @@ -1285,18 +1285,18 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, d let meth = TObjExprMethod(slotsig, [], [], [delArgVals], expr, m) mkObjExpr(delegateTy, None, BuildObjCtorCall g m, [meth], [], m) -let CoerceFromFSharpFuncToDelegate g amap infoReader ad callerArgTy m callerArgExpr delegateTy = +let CoerceFromFSharpFuncToDelegate g amap traitCtxt infoReader ad callerArgTy m callerArgExpr delegateTy = let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate infoReader delegateTy m ad - BuildNewDelegateExpr (None, g, amap, delegateTy, delInvokeMeth, delArgTys, callerArgExpr, callerArgTy, m) + BuildNewDelegateExpr (None, g, amap, traitCtxt, delegateTy, delInvokeMeth, delArgTys, callerArgExpr, callerArgTy, m) // Handle adhoc argument conversions -let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReader ad reqdTy actualTy m expr = +let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap traitCtxt infoReader ad reqdTy actualTy m expr = if isDelegateTy g reqdTy && isFunTy g actualTy then - CoerceFromFSharpFuncToDelegate g amap infoReader ad actualTy m expr reqdTy + CoerceFromFSharpFuncToDelegate g amap traitCtxt infoReader ad actualTy m expr reqdTy elif isLinqExpressionTy g reqdTy && isDelegateTy g (destLinqExpressionTy g reqdTy) && isFunTy g actualTy then let delegateTy = destLinqExpressionTy g reqdTy - let expr2 = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad delegateTy actualTy m expr + let expr2 = AdjustExprForTypeDirectedConversions tcVal g amap traitCtxt infoReader ad delegateTy actualTy m expr mkCallQuoteToLinqLambdaExpression g m delegateTy (Expr.Quote (expr2, ref None, false, m, mkQuotedExprTy g delegateTy)) // Adhoc int32 --> int64 @@ -1324,7 +1324,7 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade isNullableTy g reqdTy && not (isNullableTy g actualTy) then let underlyingTy = destNullableTy g reqdTy - let adjustedExpr = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad underlyingTy actualTy m expr + let adjustedExpr = AdjustExprForTypeDirectedConversions tcVal g amap traitCtxt infoReader ad underlyingTy actualTy m expr let adjustedActualTy = tyOfExpr g adjustedExpr let minfo = GetIntrinsicConstructorInfosOfType infoReader m reqdTy |> List.head @@ -1341,7 +1341,7 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade | None -> mkCoerceIfNeeded g reqdTy actualTy expr // Handle adhoc argument conversions -let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr = +let AdjustCallerArgExpr tcVal (g: TcGlobals) amap traitCtxt infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr = if isByrefTy g calledArgTy && isRefCellTy g callerArgTy then None, Expr.Op (TOp.RefAddrGet false, [destRefCellTy g callerArgTy], [callerArgExpr], m) @@ -1365,7 +1365,7 @@ let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledA None, callerArgExpr else - let callerArgExpr2 = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad calledArgTy callerArgTy m callerArgExpr + let callerArgExpr2 = AdjustExprForTypeDirectedConversions tcVal g amap traitCtxt infoReader ad calledArgTy callerArgTy m callerArgExpr None, callerArgExpr2 /// Some of the code below must allocate temporary variables or bind other variables to particular values. @@ -1474,7 +1474,7 @@ let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCal preBinder, { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg } // Adjust all the optional arguments, filling in values for defaults, -let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) = +let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) traitCtxt ad (assignedArg: AssignedCalledArg<_>) = let g = infoReader.g let amap = infoReader.amap let callerArg = assignedArg.CallerArg @@ -1539,7 +1539,7 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // FSharpMethod(x=b) when FSharpMethod(A) --> FSharpMethod(?x=Some(b :> A)) if isOptionTy g calledArgTy then let calledNonOptTy = destOptionTy g calledArgTy - let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr + let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap traitCtxt infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr mkSome g calledNonOptTy callerArgExpr2 m else assert false @@ -1567,7 +1567,7 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: // - VB also allows you to pass intrinsic values as optional values to parameters // typed as Object. What we do in this case is we box the intrinsic value." // -let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) mItem mMethExpr = +let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) traitCtxt ad (calledMeth: CalledMeth<_>) mItem mMethExpr = let g = infoReader.g let assignedNamedArgs = calledMeth.ArgSets |> List.collect (fun argSet -> argSet.AssignedNamedArgs) @@ -1584,8 +1584,8 @@ let AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName (infoReader let preBinder2, arg = GetDefaultExpressionForOptionalArg tcFieldInit g calledArg eCallerMemberName mItem mMethExpr arg, (preBinder >> preBinder2)) - let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) unnamedArgs - let adjustedAssignedNamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader ad) assignedNamedArgs + let adjustedNormalUnnamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader traitCtxt ad) unnamedArgs + let adjustedAssignedNamedArgs = List.map (AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName infoReader traitCtxt ad) assignedNamedArgs optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedAssignedNamedArgs @@ -1602,7 +1602,7 @@ let AdjustOutCallerArgs g (calledMeth: CalledMeth<_>) mMethExpr = |> List.unzip3 /// Adjust any '[]' arguments, converting to an array -let AdjustParamArrayCallerArgs tcVal g amap infoReader ad (calledMeth: CalledMeth<_>) mMethExpr = +let AdjustParamArrayCallerArgs tcVal g amap traitCtxt infoReader ad (calledMeth: CalledMeth<_>) mMethExpr = let argSets = calledMeth.ArgSets let paramArrayCallerArgs = argSets |> List.collect (fun argSet -> argSet.ParamArrayCallerArgs) @@ -1618,7 +1618,7 @@ let AdjustParamArrayCallerArgs tcVal g amap infoReader ad (calledMeth: CalledMet paramArrayCallerArgs |> List.map (fun callerArg -> let (CallerArg(callerArgTy, m, isOutArg, callerArgExpr)) = callerArg - AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg paramArrayCalledArgElementType paramArrayCalledArg.ReflArgInfo callerArgTy m callerArgExpr) + AdjustCallerArgExpr tcVal g amap traitCtxt infoReader ad isOutArg paramArrayCalledArgElementType paramArrayCalledArg.ReflArgInfo callerArgTy m callerArgExpr) |> List.unzip let paramArrayExpr = Expr.Op (TOp.Array, [paramArrayCalledArgElementType], paramArrayExprs, mMethExpr) @@ -1633,7 +1633,7 @@ let AdjustParamArrayCallerArgs tcVal g amap infoReader ad (calledMeth: CalledMet /// Build the argument list for a method call. Adjust for param array, optional arguments, byref arguments and coercions. /// For example, if you pass an F# reference cell to a byref then we must get the address of the /// contents of the ref. Likewise lots of adjustments are made for optional arguments etc. -let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (calledMeth: CalledMeth<_>) objArgs lambdaVars mItem mMethExpr = +let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad traitCtxt (calledMeth: CalledMeth<_>) objArgs lambdaVars mItem mMethExpr = let g = infoReader.g let amap = infoReader.amap let calledMethInfo = calledMeth.Method @@ -1652,10 +1652,10 @@ let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader // Handle param array and optional arguments let paramArrayPreBinders, paramArrayArgs = - AdjustParamArrayCallerArgs tcVal g amap infoReader ad calledMeth mMethExpr + AdjustParamArrayCallerArgs tcVal g amap traitCtxt infoReader ad calledMeth mMethExpr let optArgs, optArgPreBinder, adjustedNormalUnnamedArgs, adjustedFinalAssignedNamedArgs = - AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName infoReader ad calledMeth mItem mMethExpr + AdjustCallerArgsForOptionals tcVal tcFieldInit eCallerMemberName infoReader traitCtxt ad calledMeth mItem mMethExpr let outArgs, outArgExprs, outArgTmpBinds = AdjustOutCallerArgs g calledMeth mMethExpr @@ -1690,7 +1690,7 @@ let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader let calledArgTy = assignedArg.CalledArg.CalledArgumentType let (CallerArg(callerArgTy, m, _, e)) = assignedArg.CallerArg - AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m e) + AdjustCallerArgExpr tcVal g amap traitCtxt infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m e) |> List.unzip objArgPreBinder, objArgs, allArgsPreBinders, allArgs, allArgsCoerced, optArgPreBinder, paramArrayPreBinders, outArgExprs, outArgTmpBinds @@ -1798,7 +1798,12 @@ module ProvidedMethodCalls = (thisArg: Expr option, allArgs: Exprs, paramVars: Tainted[], - g, amap, mut, isProp, isSuperInit, m, + g, + amap, + traitCtxt, + mut, + isProp, + isSuperInit, m, expr: Tainted) = let varConv = @@ -1915,7 +1920,7 @@ module ProvidedMethodCalls = let lambdaExpr = mkLambdas g m [] vsT (delegateBodyExprR, tyOfExpr g delegateBodyExprR) let lambdaExprTy = tyOfExpr g lambdaExpr let infoReader = InfoReader(g, amap) - let exprR = CoerceFromFSharpFuncToDelegate g amap infoReader AccessorDomain.AccessibleFromSomewhere lambdaExprTy m lambdaExpr delegateTyR + let exprR = CoerceFromFSharpFuncToDelegate g amap traitCtxt infoReader AccessorDomain.AccessibleFromSomewhere lambdaExprTy m lambdaExpr delegateTyR None, (exprR, tyOfExpr g exprR) #if PROVIDED_ADDRESS_OF | ProvidedAddressOfExpr e -> @@ -2020,7 +2025,7 @@ module ProvidedMethodCalls = // fill in parameter holes in the expression - let TranslateInvokerExpressionForProvidedMethodCall tcVal (g, amap, mut, isProp, isSuperInit, mi: Tainted, objArgs, allArgs, m) = + let TranslateInvokerExpressionForProvidedMethodCall tcVal (g, amap, traitCtxt, mut, isProp, isSuperInit, mi: Tainted, objArgs, allArgs, m) = let parameters = mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) let paramTys = @@ -2046,12 +2051,12 @@ module ProvidedMethodCalls = let ea = mi.PApplyWithProvider((fun (methodInfo, provider) -> GetInvokerExpression(provider, methodInfo, [| for p in paramVars -> p.PUntaintNoFailure id |])), m) - convertProvidedExpressionToExprAndWitness tcVal (thisArg, allArgs, paramVars, g, amap, mut, isProp, isSuperInit, m, ea) + convertProvidedExpressionToExprAndWitness tcVal (thisArg, allArgs, paramVars, g, amap, traitCtxt, mut, isProp, isSuperInit, m, ea) - let BuildInvokerExpressionForProvidedMethodCall tcVal (g, amap, mi: Tainted, objArgs, mut, isProp, isSuperInit, allArgs, m) = + let BuildInvokerExpressionForProvidedMethodCall tcVal (g, amap, traitCtxt, mi: Tainted, objArgs, mut, isProp, isSuperInit, allArgs, m) = try - let methInfoOpt, (expr, retTy) = TranslateInvokerExpressionForProvidedMethodCall tcVal (g, amap, mut, isProp, isSuperInit, mi, objArgs, allArgs, m) + let methInfoOpt, (expr, retTy) = TranslateInvokerExpressionForProvidedMethodCall tcVal (g, amap, traitCtxt, mut, isProp, isSuperInit, mi, objArgs, allArgs, m) let exprTy = GetCompiledReturnTyOfProvidedMethodInfo amap m mi |> GetFSharpViewOfReturnType g let expr = mkCoerceIfNeeded g exprTy retTy expr @@ -2074,6 +2079,11 @@ let CheckRecdFieldMutation m denv (rfinfo: RecdFieldInfo) = if not rfinfo.RecdField.IsMutable then errorR (FieldNotMutable (denv, rfinfo.RecdFieldRef, m)) +let ObjArgExprNeedsAddressOf g argExprs = + match argExprs with + | [] -> false + | h :: _ -> not (isByrefTy g (tyOfExpr g h)) + /// Generate a witness for the given (solved) constraint. Five possibilities are taken /// into account. /// 1. The constraint is solved by a .NET-declared method or an F#-declared method @@ -2108,8 +2118,15 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) Choice1Of5 (ilMethInfo, minst, staticTyOpt) - | FSMethSln(ty, vref, minst, staticTyOpt) -> - Choice1Of5 (FSMeth(g, ty, vref, None), minst, staticTyOpt) + | FSMethSln(ty, vref, minst, staticTyOpt, isExt) -> + let minfo = + if isExt then + let pri = 0UL // irrelevant for post-typecheck processing of solution + FSMeth(g, ty, vref, Some pri) + else + FSMeth(g, ty, vref, None) + + Choice1Of5 (minfo, minst, staticTyOpt) | FSRecdFieldSln(tinst, rfref, isSetProp) -> Choice2Of5 (tinst, rfref, isSetProp) @@ -2158,9 +2175,9 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = // Fix bug 1281: If we resolve to an instance method on a struct and we haven't yet taken // the address of the object then go do that - if minfo.IsStruct && minfo.IsInstance then + if minfo.IsStruct && minfo.IsInstance && (minfo.ObjArgNeedsAddress(amap, m)) && ObjArgExprNeedsAddressOf g argExprs then match argExprs with - | h :: t when not (isByrefTy g (tyOfExpr g h)) -> + | h :: t -> let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) | _ -> diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index a70827d8fec..0b254d14fbd 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -382,6 +382,7 @@ val BuildNewDelegateExpr: eventInfoOpt: EventInfo option * g: TcGlobals * amap: ImportMap * + traitCtxt: ITraitContext option * delegateTy: TType * delInvokeMeth: MethInfo * delArgTys: TType list * @@ -393,6 +394,7 @@ val BuildNewDelegateExpr: val CoerceFromFSharpFuncToDelegate: g: TcGlobals -> amap: ImportMap -> + traitCtxt: ITraitContext option -> infoReader: InfoReader -> ad: AccessorDomain -> callerArgTy: TType -> @@ -405,6 +407,7 @@ val AdjustExprForTypeDirectedConversions: tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) -> g: TcGlobals -> amap: ImportMap -> + traitCtxt: ITraitContext option -> infoReader: InfoReader -> ad: AccessorDomain -> reqdTy: TType -> @@ -417,6 +420,7 @@ val AdjustCallerArgExpr: tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) -> g: TcGlobals -> amap: ImportMap -> + traitCtxt: ITraitContext option -> infoReader: InfoReader -> ad: AccessorDomain -> isOutArg: bool -> @@ -436,6 +440,7 @@ val AdjustCallerArgs: eCallerMemberName: string option -> infoReader: InfoReader -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> calledMeth: CalledMeth -> objArgs: Expr list -> lambdaVars: 'a option -> @@ -515,6 +520,7 @@ module ProvidedMethodCalls = tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) -> g: TcGlobals * amap: ImportMap * + traitCtxt: ITraitContext option * mi: Tainted * objArgs: Expr list * mut: TypedTreeOps.Mutates * diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index e317772dac4..806811a3ed4 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -852,7 +852,7 @@ module DispatchSlotChecking = | None -> () // not an F# slot // Get the slotsig of the overridden method - let slotsig = dispatchSlot.GetSlotSig(amap, m) + let slotsig = dispatchSlot.GetSlotSig(amap, m, NameResolution.traitCtxtNone) // The slotsig from the overridden method is in terms of the type parameters on the parent type of the overriding method, // Modify map the slotsig so it is in terms of the type parameters for the overriding method diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 13b0c7c3c14..87756c81272 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -38,22 +38,25 @@ open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeProviders #endif + /// An object that captures the logical context for name resolution. type NameResolver(g: TcGlobals, amap: Import.ImportMap, infoReader: InfoReader, - instantiationGenerator: range -> Typars -> TypeInst) = + instantiationGenerator: range -> Typars -> ITraitContext option -> TypeInst) = /// Used to transform typars into new inference typars - // instantiationGenerator is a function to help us create the - // type parameters by copying them from type parameter specifications read - // from IL code. - // - // When looking up items in generic types we create a fresh instantiation - // of the type, i.e. instantiate the type with inference variables. - // This means the item is returned ready for use by the type inference engine - // without further freshening. However it does mean we end up plumbing 'instantiationGenerator' - // around a bit more than we would like to, which is a bit annoying. + /// instantiationGenerator is a function to help us create the + /// type parameters by copying them from type parameter specifications read + /// from IL code. + /// + /// If these includes trait constraints then the process is context dependent. + /// + /// When looking up items in generic types we create a fresh instantiation + /// of the type, i.e. instantiate the type with inference variables. + /// This means the item is returned ready for use by the type inference engine + /// without further freshening. However it does mean we end up plumbing 'instantiationGenerator' + /// around a bit more than we would like to, which is a bit annoying. member nr.InstantiationGenerator = instantiationGenerator member nr.g = g member nr.amap = amap @@ -364,15 +367,21 @@ 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' | OpenQualified - type UnqualifiedItems = LayeredMap +let traitCtxtNone : ITraitContext option = None + /// The environment of information used to resolve names [] type NameResolutionEnv = @@ -431,6 +440,9 @@ type NameResolutionEnv = /// Extension members by type and name eIndexedExtensionMembers: TyconRefMultiMap + /// Extension members by name + eExtensionMembersByName: NameMultiMap + /// Other extension members unindexed by type eUnindexedExtensionMembers: ExtensionMember list @@ -455,6 +467,7 @@ type NameResolutionEnv = eFullyQualifiedTyconsByAccessNames = LayeredMultiMap.Empty eFullyQualifiedTyconsByDemangledNameAndArity = LayeredMap.Empty eIndexedExtensionMembers = TyconRefMultiMap<_>.Empty + eExtensionMembersByName = NameMultiMap<_>.Empty eUnindexedExtensionMembers = [] eTypars = Map.empty } @@ -724,6 +737,17 @@ let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad fi else intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter LookupIsInstance.Ambivalent m ty +let SelectExtensionMethInfosForTrait(traitInfo: TraitConstraintInfo, m, nenv: NameResolutionEnv, infoReader: InfoReader) = + let g = infoReader.g + if g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions then + [ for suportTy in traitInfo.SupportTypes do + if not (isTyparTy g suportTy) then + let isInstanceFilter = (if traitInfo.MemberFlags.IsInstance then LookupIsInstance.Yes else LookupIsInstance.No) + let extMethInfos = ExtensionMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv (Some traitInfo.MemberLogicalName) isInstanceFilter m suportTy + for extMethInfo in extMethInfos do + yield (suportTy, extMethInfo) ] + else + [] //------------------------------------------------------------------------- // Helpers to do with building environments //------------------------------------------------------------------------- @@ -760,6 +784,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 = {nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.Add (nm, Item.Value vref) } @@ -789,6 +824,7 @@ let AddValRefsToNameEnvWithPriority g 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 g) } /// Add a single F# value to the environment. @@ -801,6 +837,7 @@ let AddValRefToNameEnv g nenv (vref: ValRef) = else nenv.eUnqualifiedItems eIndexedExtensionMembers = AddValRefToExtensionMembers pri nenv.eIndexedExtensionMembers vref + eExtensionMembersByName = AddValRefToExtensionMembersByName pri nenv.eExtensionMembersByName vref ePatItems = AddValRefsToActivePatternsNameEnv g nenv.ePatItems vref } @@ -1084,16 +1121,16 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) ( /// /// Handle the .NET/C# business where nested generic types implicitly accumulate the type parameters /// from their enclosing types. -let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: TyconRef) = +let MakeNestedType (ncenv: NameResolver) traitCtxt (tinst: TType list) m (tcrefNested: TyconRef) = let tps = match tcrefNested.Typars m with [] -> [] | l -> List.skip tinst.Length l - let tinstNested = ncenv.InstantiationGenerator m tps + let tinstNested = ncenv.InstantiationGenerator m tps traitCtxt mkAppTy tcrefNested (tinst @ tinstNested) /// Get all the accessible nested types of an existing type. -let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = +let GetNestedTypesOfType (ncenv: NameResolver, ad, traitCtxt, optFilter, staticResInfo, checkForGenerated, m) ty = let tinst, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, optFilter, staticResInfo, checkForGenerated, m) ty tcrefsNested - |> List.map (MakeNestedType ncenv tinst m) + |> List.map (MakeNestedType ncenv traitCtxt tinst m) let ChooseMethInfosForNameEnv g m ty (minfos: MethInfo list) = let isExtTy = IsTypeUsedForCSharpStyleExtensionMembers g m ty @@ -1235,12 +1272,12 @@ and private AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m let flds = if isIL then [| |] else tcref.AllFieldsArray // C# style extension members - 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) @@ -1284,6 +1321,7 @@ and private AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m eUnqualifiedItems = eUnqualifiedItems ePatItems = ePatItems eIndexedExtensionMembers = eIndexedExtensionMembers + eExtensionMembersByName = eExtensionMembersByName eUnindexedExtensionMembers = eUnindexedExtensionMembers } and private CanAutoOpenTyconRef (g: TcGlobals) m (tcref: TyconRef) = @@ -1503,39 +1541,40 @@ let AddDeclaredTyparsToNameEnv check nenv typars = /// Convert a reference to a named type into a type that includes /// a fresh set of inference type variables for the type parameters. -let FreshenTycon (ncenv: NameResolver) m (tcref: TyconRef) = - let tinst = ncenv.InstantiationGenerator m (tcref.Typars m) +let FreshenTycon (ncenv: NameResolver) traitCtxt m (tcref: TyconRef) = + let tinst = ncenv.InstantiationGenerator m (tcref.Typars m) traitCtxt let improvedTy = ncenv.g.decompileType tcref tinst improvedTy /// Convert a reference to a named type into a type that includes /// a set of enclosing type instantiations and a fresh set of inference type variables for the type parameters. -let FreshenTyconWithEnclosingTypeInst (ncenv: NameResolver) m (tinstEnclosing: TypeInst) (tcref: TyconRef) = - let tps = ncenv.InstantiationGenerator m (tcref.Typars m) +let FreshenTyconWithEnclosingTypeInst (ncenv: NameResolver) traitCtxt m (tinstEnclosing: TypeInst) (tcref: TyconRef) = + let tps = ncenv.InstantiationGenerator m (tcref.Typars m) traitCtxt let tinst = List.skip tinstEnclosing.Length tps let improvedTy = ncenv.g.decompileType tcref (tinstEnclosing @ tinst) improvedTy /// Convert a reference to a union case into a UnionCaseInfo that includes /// a fresh set of inference type variables for the type parameters of the union type. -let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref: UnionCaseRef) = - let tinst = ncenv.InstantiationGenerator m (ucref.TyconRef.Typars m) + +let FreshenUnionCaseRef (ncenv: NameResolver) traitCtxt m (ucref: UnionCaseRef) = + let tinst = ncenv.InstantiationGenerator m (ucref.TyconRef.Typars m) traitCtxt UnionCaseInfo(tinst, ucref) /// Generate a new reference to a record field with a fresh type instantiation -let FreshenRecdFieldRef (ncenv: NameResolver) m (rfref: RecdFieldRef) = - RecdFieldInfo(ncenv.InstantiationGenerator m (rfref.Tycon.Typars m), rfref) +let FreshenRecdFieldRef (ncenv: NameResolver) traitCtxt m (rfref: RecdFieldRef) = + RecdFieldInfo(ncenv.InstantiationGenerator m (rfref.Tycon.Typars m) traitCtxt, rfref) /// This must be called after fetching unqualified items that may need to be freshened /// or have type instantiations -let ResolveUnqualifiedItem (ncenv: NameResolver) nenv m res = +let ResolveUnqualifiedItem (ncenv: NameResolver) traitCtxt nenv m res = match res with | Item.UnionCase(UnionCaseInfo(_, ucref), _) -> match nenv.eUnqualifiedRecordOrUnionTypeInsts.TryFind ucref.TyconRef with | Some tinst -> Item.UnionCase(UnionCaseInfo(tinst, ucref), false) | _ -> - Item.UnionCase(FreshenUnionCaseRef ncenv m ucref, false) + Item.UnionCase(FreshenUnionCaseRef ncenv traitCtxt m ucref, false) | _ -> res //------------------------------------------------------------------------- @@ -2217,7 +2256,7 @@ let CheckAllTyparsInferrable amap m item = type ResolutionInfo = | ResolutionInfo of revEntityPath: (range * EntityRef) list * reportResult: (ResultTyparChecker -> unit) * tinstEnclosing: EnclosingTypeInst - static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings, _), typarChecker) = + static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, traitCtxt, ResolutionInfo(entityPath, warnings, _), typarChecker) = entityPath |> List.iter (fun (m, eref: EntityRef) -> CheckEntityAttributes ncenv.g eref m |> CommitOperationResult CheckTyconAccessible ncenv.amap m ad eref |> ignore @@ -2225,7 +2264,7 @@ type ResolutionInfo = if eref.IsModuleOrNamespace then Item.ModuleOrNamespaces [eref] else - Item.Types(eref.DisplayName, [FreshenTycon ncenv m eref]) + Item.Types(eref.DisplayName, [FreshenTycon ncenv traitCtxt m eref]) CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occ, ad)) warnings typarChecker @@ -2528,15 +2567,15 @@ let GetRecordLabelsForType g nenv ty = result /// Get the nested types of the given type and check the nested types based on the type name resolution info. -let CheckNestedTypesOfType (ncenv: NameResolver) (resInfo: ResolutionInfo) ad nm (typeNameResInfo: TypeNameResolutionInfo) m ty = +let CheckNestedTypesOfType (ncenv: NameResolver) (resInfo: ResolutionInfo) ad traitCtxt nm (typeNameResInfo: TypeNameResolutionInfo) m ty = let tinstEnclosing, tcrefsNested = GetNestedTyconRefsOfType ncenv.InfoReader ncenv.amap (ad, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty let tcrefsNested = tcrefsNested |> List.map (fun tcrefNested -> (resInfo, tcrefNested)) let tcrefsNested = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefsNested, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) - tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv tinstEnclosing m tcrefNested) + tcrefsNested |> List.map (fun (_, tcrefNested) -> MakeNestedType ncenv traitCtxt tinstEnclosing m tcrefNested) // REVIEW: this shows up on performance logs. Consider for example endless resolutions of "List.map" to // the empty set of results, or "x.Length" for a list or array type. This indicates it could be worth adding a cache here. -let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad (id: Ident) (rest: Ident list) findFlag (typeNameResInfo: TypeNameResolutionInfo) ty = +let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad traitCtxt (id: Ident) (rest: Ident list) findFlag (typeNameResInfo: TypeNameResolutionInfo) ty = let g = ncenv.g let m = unionRanges m id.idRange let nm = id.idText // used to filter the searches of the tables @@ -2621,7 +2660,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf let nestedSearchAccessible = match rest with | [] -> - let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad nm typeNameResInfo m ty + let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad traitCtxt nm typeNameResInfo m ty if isNil nestedTypes then NoResultsOrUsefulErrors else @@ -2633,8 +2672,8 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | ResolveTypeNamesToTypeRefs -> OneSuccess (resInfo, Item.Types (nm, nestedTypes), rest) | id2 :: rest2 -> - let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty - ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad id2 rest2 findFlag typeNameResInfo nestedTypes + let nestedTypes = CheckNestedTypesOfType ncenv resInfo ad traitCtxt nm (TypeNameResolutionInfo.ResolveToTypeRefs TypeNameResolutionStaticArgsInfo.Indefinite) m ty + ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad traitCtxt id2 rest2 findFlag typeNameResInfo nestedTypes match nestedSearchAccessible with | Result res when not (isNil res) -> nestedSearchAccessible @@ -2674,7 +2713,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf raze (UndefinedName (depth, errorTextF, id, suggestMembers)) -and ResolveLongIdentInNestedTypes (ncenv: NameResolver) nenv lookupKind resInfo depth id m ad (id2: Ident) (rest: Ident list) findFlag typeNameResInfo tys = +and ResolveLongIdentInNestedTypes (ncenv: NameResolver) nenv lookupKind resInfo depth id m ad traitCtxt (id2: Ident) (rest: Ident list) findFlag typeNameResInfo tys = tys |> CollectAtMostOneResult (fun ty -> let resInfo = @@ -2683,34 +2722,34 @@ and ResolveLongIdentInNestedTypes (ncenv: NameResolver) nenv lookupKind resInfo resInfo.AddEntity(id.idRange, tcref) | _ -> resInfo - ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id2 rest findFlag typeNameResInfo ty + ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad traitCtxt id2 rest findFlag typeNameResInfo ty |> AtMostOneResult m) /// Resolve a long identifier using type-qualified name resolution. -let ResolveLongIdentInType sink (ncenv: NameResolver) nenv lookupKind m ad id findFlag typeNameResInfo ty = +let ResolveLongIdentInType sink (ncenv: NameResolver) nenv lookupKind m ad traitCtxt id findFlag typeNameResInfo ty = let resInfo, item, rest = - ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 0 m ad id [] findFlag typeNameResInfo ty + ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 0 m ad traitCtxt id [] findFlag typeNameResInfo ty |> AtMostOneResult m |> ForceRaise - ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.UseInType, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) item, rest -let private ResolveLongIdentInTyconRef (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad id rest typeNameResInfo tcref = +let private ResolveLongIdentInTyconRef (ncenv: NameResolver) nenv lookupKind (resInfo: ResolutionInfo) depth m ad traitCtxt id rest typeNameResInfo tcref = #if !NO_TYPEPROVIDERS // No dotting through type generators to get to a member! CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) #endif let ty = match resInfo.EnclosingTypeInst with - | [] -> FreshenTycon ncenv m tcref - | tinstEnclosing -> FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref - ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id rest IgnoreOverrides typeNameResInfo + | [] -> FreshenTycon ncenv traitCtxt m tcref + | tinstEnclosing -> FreshenTyconWithEnclosingTypeInst ncenv traitCtxt m tinstEnclosing tcref + ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad traitCtxt id rest IgnoreOverrides typeNameResInfo -let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv lookupKind depth m ad id rest typeNameResInfo idRange tcrefs = +let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv lookupKind depth m ad traitCtxt id rest typeNameResInfo idRange tcrefs = tcrefs |> CollectResults2 atMostOne (fun (resInfo: ResolutionInfo, tcref) -> let resInfo = resInfo.AddEntity(idRange, tcref) - tcref |> ResolveLongIdentInTyconRef ncenv nenv lookupKind resInfo depth m ad id rest typeNameResInfo |> AtMostOneResult m) + tcref |> ResolveLongIdentInTyconRef ncenv nenv lookupKind resInfo depth m ad traitCtxt id rest typeNameResInfo |> AtMostOneResult m) //------------------------------------------------------------------------- // ResolveExprLongIdentInModuleOrNamespace @@ -2720,7 +2759,7 @@ let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = let eref = modref.NestedTyconRef mspec if IsEntityAccessible amap m ad eref then Some eref else None -let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) = +let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad traitCtxt resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) = // resInfo records the modules or namespaces actually relevant to a resolution let m = unionRanges m id.idRange let lookupKind = LookupKind.Expr LookupIsInstance.No @@ -2737,7 +2776,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type match TryFindTypeWithUnionCase modref id with | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText - let ucinfo = FreshenUnionCaseRef ncenv m ucref + let ucinfo = FreshenUnionCaseRef ncenv traitCtxt m ucref let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs success [resInfo, Item.UnionCase(ucinfo, hasRequireQualifiedAccessAttribute), rest], hasRequireQualifiedAccessAttribute | _ -> NoResultsOrUsefulErrors, false @@ -2759,7 +2798,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs typeNameResInfo.StaticArgsInfo CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv lookupKind (depth+1) m ad id2 rest2 typeNameResInfo id.idRange tcrefs + ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv lookupKind (depth+1) m ad traitCtxt id2 rest2 typeNameResInfo id.idRange tcrefs // Check if we've got some explicit type arguments | _ -> @@ -2767,12 +2806,12 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToTypeRefs -> success [ for resInfo, tcref in tcrefs do - let ty = FreshenTycon ncenv m tcref + let ty = FreshenTycon ncenv traitCtxt m tcref let item = (resInfo, Item.Types(id.idText, [ty]), []) yield item ] | ResolveTypeNamesToCtors -> tcrefs - |> List.map (fun (resInfo, tcref) -> resInfo, FreshenTycon ncenv m tcref) + |> List.map (fun (resInfo, tcref) -> resInfo, FreshenTycon ncenv traitCtxt m tcref) |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) @@ -2785,7 +2824,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange, submodref) - OneResult (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) + OneResult (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad traitCtxt resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) | _ -> NoResultsOrUsefulErrors | _ -> @@ -2821,7 +2860,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type /// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. -let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = +let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, traitCtxt, nenv, id: Ident, typeNameResInfo: TypeNameResolutionInfo, tcrefs) = let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) let tys = @@ -2829,9 +2868,9 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR |> List.map (fun (resInfo, tcref) -> match resInfo.EnclosingTypeInst with | [] -> - (resInfo, FreshenTycon ncenv m tcref) + (resInfo, FreshenTycon ncenv traitCtxt m tcref) | tinstEnclosing -> - (resInfo, FreshenTyconWithEnclosingTypeInst ncenv m tinstEnclosing tcref)) + (resInfo, FreshenTyconWithEnclosingTypeInst ncenv traitCtxt m tinstEnclosing tcref)) match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> @@ -2857,7 +2896,7 @@ let ResolveUnqualifiedTyconRefs nenv tcrefs = /// Resolve F# "A.B.C" syntax in expressions /// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers /// that may represent further actions, e.g. further lookups. -let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified m ad nenv (typeNameResInfo: TypeNameResolutionInfo) (id: Ident) (rest: Ident list) isOpenDecl = +let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified m ad traitCtxt nenv (typeNameResInfo: TypeNameResolutionInfo) (id: Ident) (rest: Ident list) isOpenDecl = let lookupKind = LookupKind.Expr LookupIsInstance.No @@ -2875,9 +2914,9 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | [] -> raze (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | [next] -> - ResolveExprLongIdentPrim sink ncenv false fullyQualified m ad nenv typeNameResInfo next [] isOpenDecl + ResolveExprLongIdentPrim sink ncenv false fullyQualified m ad traitCtxt nenv typeNameResInfo next [] isOpenDecl | id2 :: rest2 -> - ResolveExprLongIdentPrim sink ncenv false FullyQualified m ad nenv typeNameResInfo id2 rest2 isOpenDecl + ResolveExprLongIdentPrim sink ncenv false FullyQualified m ad traitCtxt nenv typeNameResInfo id2 rest2 isOpenDecl else if isNil rest && fullyQualified <> FullyQualified then let mutable typeError = None @@ -2897,17 +2936,17 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length - resInfo.EnclosingTypeInst.Length) - let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) + let search = ChooseTyconRefInExpr (ncenv, m, ad, traitCtxt, nenv, id, typeNameResInfo, tcrefs) match AtMostOneResult m search with | Result (resInfo, item) -> - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) Some(resInfo.EnclosingTypeInst, item, rest) | Exception e -> typeError <- Some e None | true, res -> - let fresh = ResolveUnqualifiedItem ncenv nenv m res + let fresh = ResolveUnqualifiedItem ncenv traitCtxt nenv m res match fresh with | Item.Value value -> let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref value @@ -2929,7 +2968,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let tcrefs = LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv |> ResolveUnqualifiedTyconRefs nenv - ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, tcrefs) + ChooseTyconRefInExpr (ncenv, m, ad, traitCtxt, nenv, id, typeNameResInfo, tcrefs) let implicitOpSearch() = if IsLogicalOpName id.idText then @@ -2973,7 +3012,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match res with | Exception e -> raze e | Result (resInfo, item) -> - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) success (resInfo.EnclosingTypeInst, item, rest) // A compound identifier. @@ -2998,7 +3037,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace. let moduleSearch ad () = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl - (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) + (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad traitCtxt) // REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil. // This seems strange since we would expect in the vast majority of cases tcrefs is empty here. @@ -3012,7 +3051,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let tcrefs = let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs typeNameResInfo.StaticArgsInfo CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv lookupKind 1 m ad id2 rest2 typeNameResInfo id.idRange tcrefs + ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv lookupKind 1 m ad traitCtxt id2 rest2 typeNameResInfo id.idRange tcrefs | _ -> NoResultsOrUsefulErrors @@ -3025,7 +3064,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match nenv.eUnqualifiedItems.TryGetValue id.idText with | true, Item.UnqualifiedType _ | false, _ -> NoResultsOrUsefulErrors - | true, res -> OneSuccess (ResolutionInfo.Empty, ResolveUnqualifiedItem ncenv nenv m res, rest) + | true, res -> OneSuccess (ResolutionInfo.Empty, ResolveUnqualifiedItem ncenv traitCtxt nenv m res, rest) moduleSearch ad () +++ tyconSearch ad +++ envSearch @@ -3063,26 +3102,26 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match res with | Exception e -> raze e | Result (resInfo, item, rest) -> - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) success (resInfo.EnclosingTypeInst, item, rest) -let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid = +let ResolveExprLongIdent sink (ncenv: NameResolver) m ad traitCtxt nenv typeNameResInfo lid = match lid with | [] -> raze (Error(FSComp.SR.nrInvalidExpression(textOfLid lid), m)) - | id :: rest -> ResolveExprLongIdentPrim sink ncenv true OpenQualified m ad nenv typeNameResInfo id rest false + | id :: rest -> ResolveExprLongIdentPrim sink ncenv true OpenQualified m ad traitCtxt nenv typeNameResInfo id rest false //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in patterns //------------------------------------------------------------------------- -let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv numTyArgsOpt ad resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) = +let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv numTyArgsOpt ad traitCtxt resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) = let m = unionRanges m id.idRange match TryFindTypeWithUnionCase modref id with | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let tcref = modref.NestedTyconRef tycon let ucref = mkUnionCaseRef tcref id.idText let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - let ucinfo = FreshenUnionCaseRef ncenv m ucref + let ucinfo = FreshenUnionCaseRef ncenv traitCtxt m ucref success (resInfo, Item.UnionCase(ucinfo, showDeprecated), rest) | _ -> match mty.ExceptionDefinitionsByDemangledName.TryGetValue id.idText with @@ -3107,7 +3146,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv nu match rest with | id2 :: rest2 -> let tcrefs = tcrefs.Force() - ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult (ncenv: NameResolver) nenv LookupKind.Pattern (depth+1) m ad id2 rest2 numTyArgsOpt id.idRange tcrefs + ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult (ncenv: NameResolver) nenv LookupKind.Pattern (depth+1) m ad traitCtxt id2 rest2 numTyArgsOpt id.idRange tcrefs | _ -> NoResultsOrUsefulErrors @@ -3115,7 +3154,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv nu let ctorSearch() = if isNil rest then tcrefs.Force() - |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv traitCtxt m tcref)) |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) else @@ -3128,7 +3167,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv nu match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange, submodref) - OneResult (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) + OneResult (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad traitCtxt resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) | _ -> NoResultsOrUsefulErrors | [] -> NoResultsOrUsefulErrors @@ -3154,13 +3193,13 @@ exception UpperCaseIdentifierInPattern of range type WarnOnUpperFlag = WarnOnUpperCase | AllIdsOK // Long ID in a pattern -let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified warnOnUpper newDef m ad nenv numTyArgsOpt (id: Ident) (rest: Ident list) = +let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified warnOnUpper newDef m ad traitCtxt nenv numTyArgsOpt (id: Ident) (rest: Ident list) = if id.idText = MangledGlobalName then match rest with | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolvePatternLongIdentPrim sink ncenv FullyQualified warnOnUpper newDef m ad nenv numTyArgsOpt id2 rest2 + ResolvePatternLongIdentPrim sink ncenv FullyQualified warnOnUpper newDef m ad traitCtxt nenv numTyArgsOpt id2 rest2 else // Single identifiers in patterns if isNil rest && fullyQualified <> FullyQualified then @@ -3168,7 +3207,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa // For the special case of // let C = x match nenv.ePatItems.TryGetValue id.idText with - | true, res when not newDef -> ResolveUnqualifiedItem ncenv nenv m res + | true, res when not newDef -> ResolveUnqualifiedItem ncenv traitCtxt nenv m res | _ -> // Single identifiers in patterns - variable bindings if not newDef && @@ -3182,7 +3221,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa else let moduleSearch ad () = ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest false - (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad) + (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad traitCtxt) let tyconSearch ad = match rest with @@ -3190,7 +3229,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa let tcrefs = LookupTypeNameInEnvNoArity fullyQualified id.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) - ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Pattern 1 id.idRange ad id2 rest2 numTyArgsOpt id.idRange tcrefs + ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Pattern 1 id.idRange ad traitCtxt id2 rest2 numTyArgsOpt id.idRange tcrefs | _ -> NoResultsOrUsefulErrors @@ -3203,17 +3242,17 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa |> AtMostOneResult m |> ForceRaise - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> true)) match rest with | [] -> res | element :: _ -> error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(), element.idRange)) /// Resolve a long identifier when used in a pattern. -let ResolvePatternLongIdent sink (ncenv: NameResolver) warnOnUpper newDef m ad nenv numTyArgsOpt (lid: Ident list) = +let ResolvePatternLongIdent sink (ncenv: NameResolver) warnOnUpper newDef m ad traitCtxt nenv numTyArgsOpt (lid: Ident list) = match lid with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), m)) - | id :: rest -> ResolvePatternLongIdentPrim sink ncenv OpenQualified warnOnUpper newDef m ad nenv numTyArgsOpt id rest + | id :: rest -> ResolvePatternLongIdentPrim sink ncenv OpenQualified warnOnUpper newDef m ad traitCtxt nenv numTyArgsOpt id rest //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in types @@ -3279,15 +3318,15 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf AtMostOneResult m tyconSearch /// Resolve a long identifier representing a type name and report the result -let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) = +let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResInfo ad traitCtxt m tcref (lid: Ident list) = let resInfo, tcref = match lid with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), m)) | id :: rest -> ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref id rest) - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> true)) + let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv traitCtxt m tcref]) CallNameResolutionSink sink (rangeOfLid lid, nenv, item, emptyTyparInst, ItemOccurence.UseInType, ad) tcref @@ -3435,7 +3474,7 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full /// Resolve a long identifier representing a type and report it -let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified nenv ad (lid: Ident list) staticResInfo genOk = +let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified nenv ad traitCtxt (lid: Ident list) staticResInfo genOk = let m = rangeOfLid lid let res = match lid with @@ -3447,15 +3486,15 @@ let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified // Register the result as a name resolution match res with | Result (resInfo, tcref) -> - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> true)) + let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv traitCtxt m tcref]) CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) | _ -> () res /// Resolve a long identifier representing a type and report it -let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = - let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk +let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad traitCtxt lid staticResInfo genOk = + let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad traitCtxt lid staticResInfo genOk (res |?> fun (resInfo, tcref) -> (resInfo.EnclosingTypeInst, tcref)) //------------------------------------------------------------------------- @@ -3463,7 +3502,7 @@ let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticR //------------------------------------------------------------------------- /// Resolve a long identifier representing a record field in a module or namespace -let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad (resInfo: ResolutionInfo) depth m (modref: ModuleOrNamespaceRef) _mty (id: Ident) (rest: Ident list) = +let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad traitCtxt (resInfo: ResolutionInfo) depth m (modref: ModuleOrNamespaceRef) _mty (id: Ident) (rest: Ident list) = let typeNameResInfo = TypeNameResolutionInfo.Default let m = unionRanges m id.idRange // search for module-qualified names, e.g. { Microsoft.FSharp.Core.contents = 1 } @@ -3471,7 +3510,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad (resInfo: match TryFindTypeWithRecdField modref id with | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - success [resInfo, FieldResolution(FreshenRecdFieldRef ncenv m (modref.RecdFieldRefInNestedTycon tycon id), showDeprecated), rest] + success [resInfo, FieldResolution(FreshenRecdFieldRef ncenv traitCtxt m (modref.RecdFieldRefInNestedTycon tycon id), showDeprecated), rest] | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) // search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 } @@ -3481,9 +3520,9 @@ let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad (resInfo: let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref) if isNil tcrefs then NoResultsOrUsefulErrors else let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) - let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField (depth+1) m ad id2 rest2 typeNameResInfo id.idRange tcrefs + let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField (depth+1) m ad traitCtxt id2 rest2 typeNameResInfo id.idRange tcrefs // choose only fields - let tyconSearch = tyconSearch |?> List.choose (function resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest -> Some(resInfo, FieldResolution(FreshenRecdFieldRef ncenv m rfref, false), rest) | _ -> None) + let tyconSearch = tyconSearch |?> List.choose (function resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest -> Some(resInfo, FieldResolution(FreshenRecdFieldRef ncenv traitCtxt m rfref, false), rest) | _ -> None) tyconSearch | _ -> NoResultsOrUsefulErrors @@ -3495,7 +3534,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad (resInfo: match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange, submodref) - ResolveFieldInModuleOrNamespace ncenv nenv ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2 + ResolveFieldInModuleOrNamespace ncenv nenv ad traitCtxt resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2 |> OneResult | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) @@ -3561,7 +3600,7 @@ let SuggestLabelsOfRelatedRecords g (nenv: NameResolutionEnv) (id: Ident) (allFi UndefinedName(0, FSComp.SR.undefinedNameRecordLabel, id, suggestLabels) /// Resolve a long identifier representing a record field -let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFields = +let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad traitCtxt ty (mp, id: Ident) allFields = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g let m = id.idRange @@ -3581,13 +3620,13 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi let rfinfo = match nenv.eUnqualifiedRecordOrUnionTypeInsts.TryFind x.TyconRef with | Some tinst -> RecdFieldInfo(tinst, x) - | _ -> FreshenRecdFieldRef ncenv m x + | _ -> FreshenRecdFieldRef ncenv traitCtxt m x ResolutionInfo.Empty, FieldResolution(rfinfo, false)) match tryTcrefOfAppTy g ty with | ValueSome tcref -> match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with - | ValueSome (RecdFieldInfo(_, rfref)) -> [ResolutionInfo.Empty, FieldResolution(FreshenRecdFieldRef ncenv m rfref, false)] + | ValueSome (RecdFieldInfo(_, rfref)) -> [ResolutionInfo.Empty, FieldResolution(FreshenRecdFieldRef ncenv traitCtxt m rfref, false)] | _ -> if tcref.IsRecordTycon then // record label doesn't belong to record type -> suggest other labels of same record @@ -3611,9 +3650,9 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) - let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id2 rest2 typeNameResInfo tn.idRange tcrefs + let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad traitCtxt id2 rest2 typeNameResInfo tn.idRange tcrefs // choose only fields - let tyconSearch = tyconSearch |?> List.choose (function resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest -> Some(resInfo, FieldResolution(FreshenRecdFieldRef ncenv m rfref, false), rest) | _ -> None) + let tyconSearch = tyconSearch |?> List.choose (function resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest -> Some(resInfo, FieldResolution(FreshenRecdFieldRef ncenv traitCtxt m rfref, false), rest) | _ -> None) tyconSearch | _ -> NoResultsOrUsefulErrors @@ -3622,7 +3661,7 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi | [] -> NoResultsOrUsefulErrors | id2 :: rest2 -> ResolveLongIdentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id2 rest2 false - (ResolveFieldInModuleOrNamespace ncenv nenv ad) + (ResolveFieldInModuleOrNamespace ncenv nenv ad traitCtxt) let resInfo, item, rest = modulSearch ad () +++ tyconSearch ad +++ modulSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode @@ -3634,14 +3673,14 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi [(resInfo, item)] -let ResolveField sink ncenv nenv ad ty mp id allFields = - let res = ResolveFieldPrim sink ncenv nenv ad ty (mp, id) allFields +let ResolveField sink ncenv nenv ad traitCtxt ty mp id allFields = + let res = ResolveFieldPrim sink ncenv nenv ad traitCtxt ty (mp, id) allFields // Register the results of any field paths "Module.Type" in "Module.Type.field" as a name resolution. (Note, the path resolution // info is only non-empty if there was a unique resolution of the field) let checker = ResultTyparChecker(fun () -> true) res |> List.map (fun (resInfo, rfref) -> - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, checker) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, traitCtxt, resInfo, checker) rfref) /// Resolve F#/IL "." syntax in expressions (2). @@ -3653,9 +3692,9 @@ let ResolveField sink ncenv nenv ad ty mp id allFields = /// determine any valid members // // QUERY (instantiationGenerator cleanup): it would be really nice not to flow instantiationGenerator to here. -let private ResolveExprDotLongIdent (ncenv: NameResolver) m ad nenv ty (id: Ident) rest (typeNameResInfo: TypeNameResolutionInfo) findFlag = +let private ResolveExprDotLongIdent (ncenv: NameResolver) m ad traitCtxt nenv ty (id: Ident) rest (typeNameResInfo: TypeNameResolutionInfo) findFlag = let lookupKind = LookupKind.Expr LookupIsInstance.Yes - let adhocDotSearchAccessible = AtMostOneResult m (ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 1 m ad id rest findFlag typeNameResInfo ty) + let adhocDotSearchAccessible = AtMostOneResult m (ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 1 m ad traitCtxt id rest findFlag typeNameResInfo ty) match adhocDotSearchAccessible with | Exception _ -> // If the dot is not resolved by adhoc overloading then look for a record field @@ -3669,13 +3708,13 @@ let private ResolveExprDotLongIdent (ncenv: NameResolver) m ad nenv ty (id: Iden | true, rfref :: _ -> // NOTE (instantiationGenerator cleanup): we need to freshen here because we don't know the type. // But perhaps the caller should freshen?? - let item = Item.RecdField(FreshenRecdFieldRef ncenv m rfref) + let item = Item.RecdField(FreshenRecdFieldRef ncenv traitCtxt m rfref) OneSuccess (ResolutionInfo.Empty, item, rest) | _ -> NoResultsOrUsefulErrors let adhocDotSearchAll () = let lookupKind = LookupKind.Expr LookupIsInstance.Ambivalent - ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 1 m AccessibleFromSomeFSharpCode id rest findFlag typeNameResInfo ty + ResolveLongIdentInTypePrim ncenv nenv lookupKind ResolutionInfo.Empty 1 m AccessibleFromSomeFSharpCode traitCtxt id rest findFlag typeNameResInfo ty dotFieldIdSearch +++ adhocDotSearchAll |> AtMostOneResult m @@ -3708,7 +3747,7 @@ let NeedsWorkAfterResolution namedItem = | Item.MethodGroup(_, minfos, _) | Item.CtorGroup(_, minfos) -> minfos.Length > 1 || minfos |> List.exists (fun minfo -> not (isNil minfo.FormalMethodInst)) | Item.Property(_, pinfos) -> pinfos.Length > 1 - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(valRef=vref)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> not (List.isEmpty vref.Typars) | Item.CustomOperation (_, _, Some minfo) -> not (isNil minfo.FormalMethodInst) | Item.ActivePatternCase apref -> not (List.isEmpty apref.ActivePatternVal.Typars) @@ -3727,8 +3766,8 @@ type AfterResolution = /// Resolve a long identifier occurring in an expression position. /// /// Called for 'TypeName.Bar' - for VS IntelliSense, we can filter out instance members from method groups -let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv typeNameResInfo lid = - match ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid with +let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad traitCtxt nenv typeNameResInfo lid = + match ResolveExprLongIdent sink ncenv wholem ad traitCtxt nenv typeNameResInfo lid with | Exception e -> Exception e | Result (tinstEnclosing, item1, rest) -> let itemRange = ComputeItemRange wholem lid rest @@ -3788,19 +3827,19 @@ let (|NonOverridable|_|) namedItem = /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups /// Also called for 'GenericType.Bar' - for VS IntelliSense, we can filter out non-static members from method groups -let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad nenv ty lid (typeNameResInfo: TypeNameResolutionInfo) findFlag staticOnly = +let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameResolver) wholem ad traitCtxt nenv ty lid (typeNameResInfo: TypeNameResolutionInfo) findFlag staticOnly = let resolveExpr findFlag = let resInfo, item, rest = match lid with | id :: rest -> - ResolveExprDotLongIdent ncenv wholem ad nenv ty id rest typeNameResInfo findFlag + ResolveExprDotLongIdent ncenv wholem ad traitCtxt nenv ty id rest typeNameResInfo findFlag | _ -> error(InternalError("ResolveExprDotLongIdentAndComputeRange", wholem)) let itemRange = ComputeItemRange wholem lid rest resInfo, item, rest, itemRange // "true" resolution let resInfo, item, rest, itemRange = resolveExpr findFlag - ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, traitCtxt, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)) // Record the precise resolution of the field for intellisense/goto definition let afterResolution = @@ -3856,7 +3895,7 @@ let ResolveExprDotLongIdentAndComputeRange (sink: TcResultsSink) (ncenv: NameRes //------------------------------------------------------------------------- /// A generator of type instantiations used when no more specific type instantiation is known. -let FakeInstantiationGenerator (_m: range) gps = List.map mkTyparTy gps +let FakeInstantiationGenerator = (fun (_m: range) gps (_traitCtxt: ITraitContext option) -> List.map mkTyparTy gps) // note: using local refs is ok since it is only used by VS let ItemForModuleOrNamespaceRef v = Item.ModuleOrNamespaces [v] @@ -3893,7 +3932,7 @@ let ItemIsUnseen ad g amap m item = | _ -> false let ItemOfTyconRef ncenv m (x: TyconRef) = - Item.Types (x.DisplayName, [FreshenTycon ncenv m x]) + Item.Types (x.DisplayName, [FreshenTycon ncenv traitCtxtNone m x]) let ItemOfTy g x = let nm = @@ -3941,6 +3980,7 @@ type ResolveCompletionTargets = /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type. let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: ResolveCompletionTargets) m ad statics ty = + let traitCtxt = traitCtxtNone protectAssemblyExploration [] <| fun () -> let g = ncenv.g let amap = ncenv.amap @@ -3970,7 +4010,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso let nestedTypes = if completionTargets.ResolveAll && statics then ty - |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + |> GetNestedTypesOfType (ncenv, ad, traitCtxt, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) else [] @@ -4008,7 +4048,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso let delegateType = einfo.GetDelegateType(amap, m) let (SigOfFunctionForDelegate(delInvokeMeth, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad // Only events with void return types are suppressed in intellisense. - if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m)) then + if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m, traitCtxtNone)) then yield einfo.AddMethod.DisplayName yield einfo.RemoveMethod.DisplayName ] else [] @@ -4169,6 +4209,7 @@ let rec ResolvePartialLongIdentInType (ncenv: NameResolver) nenv isApplicableMet [ let g = ncenv.g let amap = ncenv.amap + let traitCtxt = traitCtxtNone match plid with | [] -> yield! ResolveCompletionsInType ncenv nenv isApplicableMeth m ad statics ty | id :: rest -> @@ -4196,7 +4237,7 @@ let rec ResolvePartialLongIdentInType (ncenv: NameResolver) nenv isApplicableMet yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest einfoTy // nested types - for nestedTy in GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) ty do + for nestedTy in GetNestedTypesOfType (ncenv, ad, traitCtxt, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) ty do yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad statics rest nestedTy // e.g. .. @@ -4212,7 +4253,7 @@ let InfosForTyconConstructors (ncenv: NameResolver) m ad (tcref: TyconRef) = let amap = ncenv.amap // Don't show constructors for type abbreviations. See FSharp 1.0 bug 2881 if not tcref.IsTypeAbbrev then - let ty = FreshenTycon ncenv m tcref + let ty = FreshenTycon ncenv traitCtxtNone m tcref match ResolveObjectConstructor ncenv (DisplayEnv.Empty g) m ad ty with | Result item -> match item with @@ -4397,7 +4438,7 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) |> List.tryHead |> Option.map (fun tcref -> let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m - FreshenTycon ncenv m tcref) + FreshenTycon ncenv traitCtxtNone m tcref) | _ -> None /// allowObsolete - specifies whether we should return obsolete types & modules @@ -4505,7 +4546,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m - let ty = FreshenTycon ncenv m tcref + let ty = FreshenTycon ncenv traitCtxtNone m tcref yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty // 'T.Ident: lookup a static something in a type parameter @@ -4565,7 +4606,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe for tycon in tycons do let nested = modref.NestedTyconRef tycon if IsEntityAccessible ncenv.amap m ad nested then - let ttype = FreshenTycon ncenv m nested + let ttype = FreshenTycon ncenv traitCtxtNone m nested yield! ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype) |> List.map Item.RecdField @@ -4588,7 +4629,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe |> List.filter (fun tc -> tc.IsRecordTycon) |> List.collect (fun tycon -> let tcref = modref.NestedTyconRef tycon - let ttype = FreshenTycon ncenv m tcref + let ttype = FreshenTycon ncenv traitCtxtNone m tcref ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype)) |> List.map Item.RecdField | _ -> [] @@ -4668,7 +4709,7 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: let tycons = LookupTypeNameInEnvNoArity OpenQualified id nenv tycons |> List.collect (fun tcref -> - let ttype = FreshenTycon ncenv m tcref + let ttype = FreshenTycon ncenv traitCtxtNone m tcref ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype)) |> List.map Item.RecdField | _-> [] @@ -4713,7 +4754,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( |> List.map Item.ILField | Item.Types _ -> if statics then - yield! ty |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) |> List.map (ItemOfTy g) + yield! ty |> GetNestedTypesOfType (ncenv, ad, traitCtxtNone, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) |> List.map (ItemOfTy g) | _ -> if not statics then match tryDestAnonRecdTy g ty with @@ -4749,11 +4790,10 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( let delegateType = einfo.GetDelegateType(amap, m) let (SigOfFunctionForDelegate(delInvokeMeth, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad // Only events with void return types are suppressed in intellisense. - if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m)) then + if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m, traitCtxtNone)) then yield einfo.AddMethod.DisplayName yield einfo.RemoveMethod.DisplayName ] - let pinfos = pinfosIncludingUnseen |> List.filter (fun x -> not (PropInfoIsUnseen m x)) @@ -4880,7 +4920,7 @@ let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad sta ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun fref -> fref.LogicalName = id && IsRecdFieldAccessible ncenv.amap m ad fref.RecdFieldRef && fref.RecdField.IsStatic = statics) - let nestedTypes = ty |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + let nestedTypes = ty |> GetNestedTypesOfType (ncenv, ad, traitCtxtNone, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) // e.g. .. for rfinfo in rfinfos do @@ -5113,7 +5153,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a // type.lookup: lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m - let ty = FreshenTycon ncenv m tcref + let ty = FreshenTycon ncenv traitCtxtNone m tcref yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } @@ -5140,3 +5180,4 @@ let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResol && EntityRefContainsSomethingAccessible ncenv m ad x && not (IsTyconUnseen ad ncenv.g ncenv.amap m x)) ) + diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index c93881d7712..51482526a20 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -18,7 +18,10 @@ open FSharp.Compiler.TcGlobals type NameResolver = new: - g: TcGlobals * amap: ImportMap * infoReader: InfoReader * instantiationGenerator: (range -> Typars -> TypeInst) -> + g: TcGlobals * + amap: ImportMap * + infoReader: InfoReader * + instantiationGenerator: (range -> Typars -> ITraitContext option -> TypeInst) -> NameResolver member InfoReader: InfoReader @@ -172,11 +175,16 @@ type ExtensionMember = /// IL-style extension member, backed by some kind of method with an [] attribute | ILExtMem of TyconRef * MethInfo * ExtensionMethodPriority + /// 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 +/// Freshen a trait for use at a particular location /// The environment of information used to resolve names + [] type NameResolutionEnv = { @@ -225,6 +233,9 @@ type NameResolutionEnv = /// Extension members by type and name eIndexedExtensionMembers: TyconRefMultiMap + /// Extension members by name + eExtensionMembersByName: NameMultiMap + /// Other extension members unindexed by type eUnindexedExtensionMembers: ExtensionMember list @@ -651,6 +662,9 @@ val internal AllMethInfosOfTypeInScope: ty: TType -> MethInfo list +val internal SelectExtensionMethInfosForTrait: + traitInfo: TraitConstraintInfo * m: range * nenv: NameResolutionEnv * infoReader: InfoReader -> (TType * MethInfo) list + /// Used to report an error condition where name resolution failed due to an indeterminate type exception internal IndeterminateType of range @@ -658,7 +672,7 @@ exception internal IndeterminateType of range exception internal UpperCaseIdentifierInPattern of range /// Generate a new reference to a record field with a fresh type instantiation -val FreshenRecdFieldRef: NameResolver -> range -> RecdFieldRef -> RecdFieldInfo +val FreshenRecdFieldRef: NameResolver -> ITraitContext option -> range -> RecdFieldRef -> RecdFieldInfo /// Resolve a long identifier to a namespace, module. val internal ResolveLongIdentAsModuleOrNamespace: @@ -687,6 +701,7 @@ val internal ResolveLongIdentInType: lookupKind: LookupKind -> m: range -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> id: Ident -> findFlag: FindMemberFlag -> typeNameResInfo: TypeNameResolutionInfo -> @@ -701,6 +716,7 @@ val internal ResolvePatternLongIdent: newDef: bool -> m: range -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> nenv: NameResolutionEnv -> numTyArgsOpt: TypeNameResolutionInfo -> lid: Ident list -> @@ -713,6 +729,7 @@ val internal ResolveTypeLongIdentInTyconRef: nenv: NameResolutionEnv -> typeNameResInfo: TypeNameResolutionInfo -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> m: range -> tcref: TyconRef -> lid: Ident list -> @@ -726,6 +743,7 @@ val internal ResolveTypeLongIdent: fullyQualified: FullyQualifiedFlag -> nenv: NameResolutionEnv -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> lid: Ident list -> staticResInfo: TypeNameResolutionStaticArgsInfo -> genOk: PermitDirectReferenceToGeneratedType -> @@ -737,6 +755,7 @@ val internal ResolveField: ncenv: NameResolver -> nenv: NameResolutionEnv -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> ty: TType -> mp: Ident list -> id: Ident -> @@ -749,6 +768,7 @@ val internal ResolveExprLongIdent: ncenv: NameResolver -> m: range -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> nenv: NameResolutionEnv -> typeNameResInfo: TypeNameResolutionInfo -> lid: Ident list -> @@ -769,6 +789,7 @@ val internal ResolveLongIdentAsExprAndComputeRange: ncenv: NameResolver -> wholem: range -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> nenv: NameResolutionEnv -> typeNameResInfo: TypeNameResolutionInfo -> lid: Ident list -> @@ -780,6 +801,7 @@ val internal ResolveExprDotLongIdentAndComputeRange: ncenv: NameResolver -> wholem: range -> ad: AccessorDomain -> + traitCtxt: ITraitContext option -> nenv: NameResolutionEnv -> ty: TType -> lid: Ident list -> @@ -789,11 +811,15 @@ val internal ResolveExprDotLongIdentAndComputeRange: Item * range * Ident list * AfterResolution /// A generator of type instantiations used when no more specific type instantiation is known. -val FakeInstantiationGenerator: range -> Typar list -> TType list +val FakeInstantiationGenerator: (range -> Typars -> ITraitContext option -> TypeInst) /// Try to resolve a long identifier as type. val TryToResolveLongIdentAsType: NameResolver -> NameResolutionEnv -> range -> string list -> TType option +/// Resolve a (possibly incomplete) long identifier to a loist of possible class or record fields +val ResolvePartialLongIdentToClassOrRecdFields: + NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> bool -> bool -> Item list + /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions. val ResolvePartialLongIdent: ncenv: NameResolver -> @@ -828,3 +854,8 @@ val IsItemResolvable: NameResolver -> NameResolutionEnv -> range -> AccessorDoma val TrySelectExtensionMethInfoOfILExtMem: range -> ImportMap -> TType -> TyconRef * MethInfo * ExtensionMethodPriority -> MethInfo option + +val traitCtxtNone: ITraitContext option + +val ExtensionMethInfosOfTypeInScope: + ResultCollectionSettings -> InfoReader -> NameResolutionEnv -> string option -> isInstanceFilter: LookupIsInstance -> range -> TType -> MethInfo list diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 6f2bcb62f80..ecbe8e55124 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -803,7 +803,7 @@ module PrintTypes = and layoutTraitWithInfo denv env traitInfo = let g = denv.g - let (TTrait(tys, _, memFlags, _, _, _)) = traitInfo + let (TTrait(tys, _, memFlags, _, _, _, _)) = traitInfo let nm = traitInfo.MemberDisplayNameCore let nameL = ConvertValLogicalNameToDisplayLayout false (tagMember >> wordL) nm if denv.shortConstraints then @@ -825,7 +825,7 @@ module PrintTypes = let tysL = match tys with | [ty] -> layoutTypeWithInfo denv env ty - | tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys) + | _ -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys) let retTyL = layoutReturnType denv env retTy let sigL = diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 9338abd28f5..fcd9564e7d2 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -337,7 +337,7 @@ let rec CheckTypeDeep (cenv: cenv) (visitTy, visitTyconRefOpt, visitAppTyOpt, vi | 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.Value with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () @@ -423,7 +423,7 @@ and CheckTypeConstraintDeep cenv f g env x = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> () -and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env (TTrait(tys, _, _, argTys, retTy, soln)) = +and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env (TTrait(tys, _, _, argTys, retTy, soln, _traitCtxt)) = CheckTypesDeep cenv f g env tys CheckTypesDeep cenv f g env argTys Option.iter (CheckTypeDeep cenv f g env true ) retTy @@ -648,7 +648,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = let visitTraitSolution info = match info with - | FSMethSln(_, vref, _, _) -> + | FSMethSln(valRef=vref) -> //printfn "considering %s..." vref.DisplayName if valRefInThisAssembly cenv.g.compilingFSharpCore vref && not (cenv.boundVals.ContainsKey(vref.Stamp)) then //printfn "recording %s..." vref.DisplayName @@ -2277,12 +2277,17 @@ let CheckEntityDefn cenv env (tycon: Entity) = |> List.filter (fun minfo -> minfo.IsVirtual) | None -> [] - let namesOfMethodsThatMayDifferOnlyInReturnType = ["op_Explicit";"op_Implicit"] (* hardwired *) - let methodUniquenessIncludesReturnType (minfo: MethInfo) = List.contains minfo.LogicalName namesOfMethodsThatMayDifferOnlyInReturnType + let methodUniquenessIncludesReturnType (minfo: MethInfo) = + minfo.LogicalName = "op_Explicit" || + minfo.LogicalName = "op_Implicit" || + (g.langVersion.SupportsFeature LanguageFeature.ExtensionConstraintSolutions && + AttributeChecking.MethInfoHasAttribute g m g.attrib_AllowOverloadByReturnTypeAttribute minfo) + let MethInfosEquivWrtUniqueness eraseFlag m minfo minfo2 = - if methodUniquenessIncludesReturnType minfo - then MethInfosEquivByNameAndSig eraseFlag true g cenv.amap m minfo minfo2 - else MethInfosEquivByNameAndPartialSig eraseFlag true g cenv.amap m minfo minfo2 (* partial ignores return type *) + if methodUniquenessIncludesReturnType minfo then + MethInfosEquivByNameAndSig eraseFlag true g cenv.amap m minfo minfo2 + else + MethInfosEquivByNameAndPartialSig eraseFlag true g cenv.amap m minfo minfo2 (* partial ignores return type *) let immediateMeths = [ for v in tycon.AllGeneratedValues do yield FSMeth (g, ty, v, None) diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index feaaf09e71b..c66e414add8 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -370,6 +370,14 @@ let ImportReturnTypeFromMetadata amap m ilTy getCattrs scoref tinst minst = | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) +/// If you use a generic thing, then the extension members in scope at the point of _use_ +/// are the ones available to solve the constraint +let FreshenTrait (traitCtxt: ITraitContext option) traitInfo = + let (TTrait(typs, nm, mf, argtys, rty, slnCell, traitCtxtOld)) = traitInfo + let traitCtxtNew = match traitCtxt with None -> traitCtxtOld | Some _ -> traitCtxt + + TTrait(typs, nm, mf, argtys, rty, slnCell, traitCtxtNew) + /// Copy constraints. If the constraint comes from a type parameter associated /// with a type constructor then we are simply renaming type variables. If it comes /// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the @@ -378,7 +386,7 @@ let ImportReturnTypeFromMetadata amap m ilTy getCattrs scoref tinst minst = /// /// Note: this now looks identical to constraint instantiation. -let CopyTyparConstraints m tprefInst (tporig: Typar) = +let CopyTyparConstraints traitCtxt m tprefInst (tporig: Typar) = tporig.Constraints |> List.map (fun tpc -> match tpc with @@ -407,11 +415,12 @@ let CopyTyparConstraints m tprefInst (tporig: Typar) = | TyparConstraint.RequiresDefaultConstructor _ -> TyparConstraint.RequiresDefaultConstructor m | TyparConstraint.MayResolveMember(traitInfo, _) -> - TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) + let traitInfo2 = FreshenTrait traitCtxt traitInfo + TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo2, m)) /// The constraints for each typar copied from another typar can only be fixed up once /// we have generated all the new constraints, e.g. f List, B :> List> ... -let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = +let FixupNewTypars traitCtxt m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = // Checks.. These are defensive programming against early reported errors. let n0 = formalEnclosingTypars.Length let n1 = tinst.Length @@ -423,6 +432,6 @@ let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsori // The real code.. let renaming, tptys = mkTyparToTyparRenaming tpsorig tps let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints traitCtxt m tprefInst tporig)) renaming, tptys diff --git a/src/Compiler/Checking/TypeHierarchy.fsi b/src/Compiler/Checking/TypeHierarchy.fsi index 225e6187477..7b11b4e704f 100644 --- a/src/Compiler/Checking/TypeHierarchy.fsi +++ b/src/Compiler/Checking/TypeHierarchy.fsi @@ -161,11 +161,17 @@ val ImportReturnTypeFromMetadata: /// /// Note: this now looks identical to constraint instantiation. -val CopyTyparConstraints: m: range -> tprefInst: TyparInstantiation -> tporig: Typar -> TyparConstraint list +val CopyTyparConstraints: + traitCtxt: ITraitContext option -> + m: range -> + tprefInst: TyparInstantiation -> + tporig: Typar -> + TyparConstraint list /// The constraints for each typar copied from another typar can only be fixed up once /// we have generated all the new constraints, e.g. f List, B :> List> ... val FixupNewTypars: + traitCtxt: ITraitContext option -> m: range -> formalEnclosingTypars: Typars -> tinst: TType list -> diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 68e844fa919..ab8a5865306 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -638,6 +638,9 @@ type MethInfo = | ProvidedMeth of amap: ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range #endif + // Marker interface + interface ITraitExtensionMember + /// Get the enclosing type of the method info. /// /// If this is an extension member, then this is the apparent parent, i.e. the type the method appears to extend. @@ -948,7 +951,8 @@ type MethInfo = | ILMeth (_, _, Some _) -> true | _ -> false - /// Indicates if this is an extension member (e.g. on a struct) that takes a byref arg + /// Indicates if this is an instance member on a struct, or + /// an extension instance member on a struct that takes a byref arg. member x.ObjArgNeedsAddress (amap: ImportMap, m) = (x.IsStruct && not x.IsExtensionMember) || match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with @@ -1210,7 +1214,7 @@ type MethInfo = // // This code has grown organically over time. We've managed to unify the ILMeth+ProvidedMeth paths. // The FSMeth, ILMeth+ProvidedMeth paths can probably be unified too. - member x.GetSlotSig(amap, m) = + member x.GetSlotSig(amap, m, traitCtxt) = match x with | FSMeth(g, _, vref, _) -> match vref.RecursiveValInfo with @@ -1241,9 +1245,9 @@ type MethInfo = let tcref = tcrefOfAppTy g x.ApparentEnclosingAppType let formalEnclosingTyparsOrig = tcref.Typars m let formalEnclosingTypars = copyTypars false formalEnclosingTyparsOrig - let _, formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars + let _, formalEnclosingTyparTys = FixupNewTypars traitCtxt m [] [] formalEnclosingTyparsOrig formalEnclosingTypars let formalMethTypars = copyTypars false x.FormalMethodTypars - let _, formalMethTyparTys = FixupNewTypars m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars + let _, formalMethTyparTys = FixupNewTypars traitCtxt m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars let formalRetTy, formalParams = match x with diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index 550c7860b34..c7f4986bda1 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -320,6 +320,8 @@ type MethInfo = m: range #endif + interface ITraitExtensionMember + /// Get the enclosing type of the method info, using a nominal type for tuple types member ApparentEnclosingAppType: TType @@ -521,7 +523,7 @@ type MethInfo = member GetParamTypes: amap: ImportMap * m: range * minst: TType list -> TType list list /// Get the signature of an abstract method slot. - member GetSlotSig: amap: ImportMap * m: range -> SlotSig + member GetSlotSig: amap: ImportMap * m: range * traitCtxt: ITraitContext option -> SlotSig /// Get the ParamData objects for the parameters of a MethInfo member HasParamArrayArg: amap: ImportMap * m: range * minst: TType list -> bool diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 20208e2870c..76d3698ea41 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -25,6 +25,7 @@ open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Import open FSharp.Compiler.LowerStateMachines +open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps @@ -541,7 +542,7 @@ type TypeReprEnv(reprs: Map, count: int, templateReplacement: (Ty member _.WithoutTemplateReplacement() = TypeReprEnv(reprs, count, None) /// Lookup a type parameter - member _.Item(tp: Typar, m: range) = + member _.LookupTyparRepr(tp: Typar, m: range) = try reprs[tp.Stamp] with :? KeyNotFoundException -> @@ -713,7 +714,7 @@ and GenTypeAux cenv m (tyenv: TypeReprEnv) voidOK ptrsOK ty = else EraseClosures.mkILTyFuncTy cenv.ilxPubCloEnv - | TType_var (tp, _) -> mkILTyvarTy tyenv[tp, m] + | TType_var (tp, _) -> mkILTyvarTy (tyenv.LookupTyparRepr(tp, m)) | TType_measure _ -> g.ilg.typ_Int32 @@ -6056,7 +6057,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel | [ meth ] when meth.IsInstance -> meth | _ -> error (InternalError(sprintf "expected method %s not found" imethName, m)) - let slotsig = implementedMeth.GetSlotSig(amap, m) + let slotsig = implementedMeth.GetSlotSig(amap, m, traitCtxtNone) let ilOverridesSpec = GenOverridesSpec cenv eenvinner slotsig m mdef.CallingConv.IsInstance @@ -6601,7 +6602,9 @@ and GenGenericParams cenv eenv tps = tps |> DropErasedTypars |> List.map (GenGenericParam cenv eenv) and GenGenericArgs m (tyenv: TypeReprEnv) tps = - tps |> DropErasedTypars |> List.map (fun c -> (mkILTyvarTy tyenv[c, m])) + tps + |> DropErasedTypars + |> List.map (fun c -> mkILTyvarTy (tyenv.LookupTyparRepr(c, m))) /// Generate a local type function contract class and implementation and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars expr m = diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 270f6e948b9..1c637555acd 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -43,6 +43,7 @@ open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader open FSharp.Compiler.IO +open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.ScriptClosure @@ -850,7 +851,7 @@ let main3 ApplyAllOptimizations( tcConfig, tcGlobals, - (LightweightTcValForUsingInBuildMethodCall tcGlobals), + (LightweightTcValForUsingInBuildMethodCall tcGlobals traitCtxtNone), outfile, importMap, false, @@ -932,7 +933,13 @@ let main4 // Create the Abstract IL generator let ilxGenerator = - CreateIlxAssemblyGenerator(tcConfig, tcImports, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), generatedCcu) + CreateIlxAssemblyGenerator( + tcConfig, + tcImports, + tcGlobals, + (LightweightTcValForUsingInBuildMethodCall tcGlobals traitCtxtNone), + generatedCcu + ) let codegenBackend = (if Option.isSome dynamicAssemblyCreator then diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 7e460abeb92..b7c069c0471 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -310,9 +310,9 @@ csExpectedArguments,"Expected arguments to an instance member" csIndexArgumentMismatch,"This indexer expects %d arguments but is here given %d" csExpectTypeWithOperatorButGivenFunction,"Expecting a type supporting the operator '%s' but given a function type. You may be missing an argument to a function." csExpectTypeWithOperatorButGivenTuple,"Expecting a type supporting the operator '%s' but given a tuple type" -csTypesDoNotSupportOperator,"None of the types '%s' support the operator '%s'" +csTypesDoNotSupportOperator,"The types '%s' do not support the operator '%s'" csTypeDoesNotSupportOperator,"The type '%s' does not support the operator '%s'" -csTypesDoNotSupportOperatorNullable,"None of the types '%s' support the operator '%s'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'." +csTypesDoNotSupportOperatorNullable,"The types '%s' do not support the operator '%s'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'." csTypeDoesNotSupportOperatorNullable,"The type '%s' does not support the operator '%s'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'." csTypeDoesNotSupportConversion,"The type '%s' does not support a conversion to the type '%s'" csMethodFoundButIsStatic,"The type '%s' has a method '%s' (full name '%s'), but the method is static" @@ -1547,6 +1547,7 @@ featureAndBang,"applicative computation expressions" featureResumableStateMachines,"resumable state machines" featureNullableOptionalInterop,"nullable optional interop" featureDefaultInterfaceMemberConsumption,"default interface member consumption" +featureExtensionConstraintSolutions,"extension constraint solutions" featureStringInterpolation,"string interpolation" featureWitnessPassing,"witness passing for trait constraints in F# quotations" featureAdditionalImplicitConversions,"additional type-directed conversions" diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 98a87e8d736..335ca96b3be 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -309,12 +309,12 @@ + + - - diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 8644fbe9971..8739976cf25 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -37,6 +37,7 @@ type LanguageFeature = | StringInterpolation | OverloadsForCustomOperations | ExpandedMeasurables + | ExtensionConstraintSolutions | StructActivePattern | PrintfBinaryFormat | IndexerNotationWithoutDot @@ -125,6 +126,7 @@ type LanguageVersion(versionText) = // F# preview LanguageFeature.FromEndSlicing, previewVersion + LanguageFeature.ExtensionConstraintSolutions, previewVersion LanguageFeature.MatchNotAllowedForUnionCaseWithNoData, previewVersion ] @@ -225,6 +227,7 @@ type LanguageVersion(versionText) = | LanguageFeature.MLCompatRevisions -> FSComp.SR.featureMLCompatRevisions () | LanguageFeature.BetterExceptionPrinting -> FSComp.SR.featureBetterExceptionPrinting () | LanguageFeature.DelegateTypeNameResolutionFix -> FSComp.SR.featureDelegateTypeNameResolutionFix () + | LanguageFeature.ExtensionConstraintSolutions -> FSComp.SR.featureExtensionConstraintSolutions() | LanguageFeature.ReallyLongLists -> FSComp.SR.featureReallyLongList () | LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess -> FSComp.SR.featureErrorOnDeprecatedRequireQualifiedAccess () | LanguageFeature.RequiredPropertiesSupport -> FSComp.SR.featureRequiredProperties () diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 694a6ae73fd..15fb6398d5d 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -27,6 +27,7 @@ type LanguageFeature = | StringInterpolation | OverloadsForCustomOperations | ExpandedMeasurables + | ExtensionConstraintSolutions | StructActivePattern | PrintfBinaryFormat | IndexerNotationWithoutDot diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5660f844d71..af35ad2eb71 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1635,7 +1635,7 @@ type internal FsiDynamicCompiler( let importMap = tcImports.GetImportMap() // optimize: note we collect the incremental optimization environment - let optimizedImpls, _optData, optEnv = ApplyAllOptimizations (tcConfig, tcGlobals, LightweightTcValForUsingInBuildMethodCall tcGlobals, outfile, importMap, isIncrementalFragment, optEnv, tcState.Ccu, declaredImpls) + let optimizedImpls, _optData, optEnv = ApplyAllOptimizations (tcConfig, tcGlobals, LightweightTcValForUsingInBuildMethodCall tcGlobals traitCtxtNone, outfile, importMap, isIncrementalFragment, optEnv, tcState.Ccu, declaredImpls) diagnosticsLogger.AbortOnError(fsiConsoleOutput) let fragName = textOfLid prefixPath @@ -2248,7 +2248,7 @@ type internal FsiDynamicCompiler( let tcState = GetInitialTcState (rangeStdin0, ccuName, tcConfig, tcGlobals, tcImports, tcEnv, openDecls0) - let ilxGenerator = CreateIlxAssemblyGenerator (tcConfig, tcImports, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), tcState.Ccu) + let ilxGenerator = CreateIlxAssemblyGenerator (tcConfig, tcImports, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals traitCtxtNone), tcState.Ccu) { optEnv = optEnv0 emEnv = emEnv0 @@ -3251,7 +3251,7 @@ type FsiInteractionProcessor let ad = tcState.TcEnvFromImpls.AccessRights let nenv = tcState.TcEnvFromImpls.NameEnv - let nItems = ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox istate.tcGlobals amap rangeStdin0) rangeStdin0 ad lid false + let nItems = ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox istate.tcGlobals amap rangeStdin0 traitCtxtNone) rangeStdin0 ad lid false let names = nItems |> List.map (fun d -> d.DisplayName) let names = names |> List.filter (fun name -> name.StartsWithOrdinal(stem)) names diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 0abff6d4d04..abfc209fda3 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -468,7 +468,7 @@ type internal TypeCheckInfo // a single item (pick the first one) and we need the residue (which may be "") | CNR (Item.Types (_, ty :: _), _, denv, nenv, ad, m) :: _, Some _ -> let targets = - ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m traitCtxtNone) let items = ResolveCompletionsInType ncenv nenv targets m ad true ty let items = List.map ItemWithNoInst items @@ -477,7 +477,7 @@ type internal TypeCheckInfo // Exact resolution via 'T.$ | CNR (Item.TypeVar (_, tp), _, denv, nenv, ad, m) :: _, Some _ -> let targets = - ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m traitCtxtNone) let items = ResolveCompletionsInType ncenv nenv targets m ad true (mkTyparTy tp) let items = List.map ItemWithNoInst items @@ -513,7 +513,7 @@ type internal TypeCheckInfo | _ -> ad let targets = - ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m traitCtxtNone) let items = ResolveCompletionsInType ncenv nenv targets m ad false ty let items = List.map ItemWithNoInst items @@ -689,7 +689,7 @@ type internal TypeCheckInfo let ty, nenv, ad, m = bestQual let targets = - ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m traitCtxtNone) let items = ResolveCompletionsInType ncenv nenv targets m ad false ty let items = items |> List.map ItemWithNoInst @@ -706,7 +706,7 @@ type internal TypeCheckInfo /// Find items in the best naming environment. let GetEnvironmentLookupResolutions (nenv, ad, m, plid, filterCtors, showObsolete) = let items = - ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete + ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m traitCtxtNone) m ad plid showObsolete let items = items |> List.map ItemWithNoInst let items = items |> RemoveDuplicateItems g @@ -3049,7 +3049,7 @@ type FSharpCheckProjectResults let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) let tcConfig = getTcConfig () let isIncrementalFragment = false - let tcVal = LightweightTcValForUsingInBuildMethodCall tcGlobals + let tcVal = LightweightTcValForUsingInBuildMethodCall tcGlobals traitCtxtNone let optimizedImpls, _optimizationData, _ = ApplyAllOptimizations(tcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv0, thisCcu, mimpls) diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 06cf656b078..ed890b58789 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -153,7 +153,7 @@ module DeclarationListHelpers = let denv = SimplerDisplayEnv denv let xml = GetXmlCommentForItem infoReader m item.Item match item.Item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(valRef=vref)) }) -> // operator with solution FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv { item with Item = Item.Value vref } diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index eabc11f3410..01fcfcacc75 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -899,7 +899,7 @@ module FSharpExprConvert = let typR = ConvType cenv (mkAppTy tycr tyargs) E.UnionCaseTag(ConvExpr cenv env arg1, typR) - | TOp.TraitCall (TTrait(tys, nm, memFlags, argTys, _retTy, _solution)), _, _ -> + | TOp.TraitCall (TTrait(tys, nm, memFlags, argTys, _retTy, _solution, _traitCtxt)), _, _ -> let tysR = ConvTypes cenv tys let tyargsR = ConvTypes cenv tyargs let argTysR = ConvTypes cenv argTys diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index a3232c3db39..babc0a96562 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -111,7 +111,7 @@ module internal SymbolHelpers = | Item.SetterArg (_, item) -> rangeOfItem g preferFlag item | Item.ArgName (_, _, _, m) -> Some m | Item.CustomOperation (_, _, implOpt) -> implOpt |> Option.bind (rangeOfMethInfo g preferFlag) - | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(vref=vref))}) -> Some vref.Range + | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(valRef=vref))}) -> Some vref.Range | Item.ImplicitOp _ -> None | Item.UnqualifiedType tcrefs -> tcrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.DelegateCtor ty @@ -566,7 +566,7 @@ module internal SymbolHelpers = let rec FullNameOfItem g item = let denv = DisplayEnv.Empty g match item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(valRef=vref)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> fullDisplayTextOfValRef vref | Item.UnionCase (ucinfo, _) -> fullDisplayTextOfUnionCaseRef ucinfo.UnionCaseRef | Item.ActivePatternResult(apinfo, _ty, idx, _) -> apinfo.DisplayNameByIdx idx @@ -612,7 +612,7 @@ module internal SymbolHelpers = match item with | Item.ImplicitOp(_, sln) -> match sln.Value with - | Some(TraitConstraintSln.FSMethSln(vref=vref)) -> + | Some(TraitConstraintSln.FSMethSln(valRef=vref)) -> GetXmlCommentForItem infoReader m (Item.Value vref) | Some (TraitConstraintSln.ILMethSln _) | Some (TraitConstraintSln.FSRecdFieldSln _) diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 4b8f8c4684b..64c5331f185 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -58,7 +58,8 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports, amap: Import.ImportMap, infoReader: InfoReader) = - let tcVal = CheckExpressions.LightweightTcValForUsingInBuildMethodCall g + // TODO: the use of traitCtxtNone is suspect. + let tcVal = CheckExpressions.LightweightTcValForUsingInBuildMethodCall g traitCtxtNone new(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports) = let amap = tcImports.GetImportMap() @@ -325,7 +326,7 @@ type FSharpSymbol(cenv: SymbolEnv, item: unit -> Item, access: FSharpSymbol -> C | Item.ArgName(id, ty, argOwner, m) -> FSharpParameter(cenv, id, ty, argOwner, m) :> _ - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(valRef=vref)) }) -> FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ // TODO: the following don't currently return any interesting subtype @@ -1429,7 +1430,7 @@ type FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = (fun () -> Item.Trait(info)), (fun _ _ _ad -> true)) - let (TTrait(tys, nm, flags, atys, retTy, _)) = info + let (TTrait(tys, nm, flags, atys, retTy, _, _)) = info member _.MemberSources = tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 9ab7cf2f723..6f8474cde52 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1412,6 +1412,7 @@ type TcGlobals( member val attrib_InlineIfLambdaAttribute = mk_MFCore_attrib "InlineIfLambdaAttribute" member val attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute" member val attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" + member val attrib_AllowOverloadByReturnTypeAttribute = mk_MFCore_attrib "AllowOverloadByReturnTypeAttribute" member val attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute" member val attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute" member val attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute" diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index dfdc9640a0c..61e1fb6e4f9 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2369,6 +2369,24 @@ type TyparConstraint = //member x.DebugText = x.ToString() override x.ToString() = sprintf "%+A" x + +/// Represents the ability to solve traits via extension methods in a particular scope. +/// +/// Only satisfied by types defined elsewhere (e.g. NameResolutionEnv), and not stored in TypedTreePickle. +type ITraitContext = + /// Used to select the extension methods in the context relevant to solving the constraint + /// given the current support types + abstract SelectExtensionMethods: TraitConstraintInfo * range * infoReader: obj -> (TType * ITraitExtensionMember) list + + /// Gives the access rights (e.g. InternalsVisibleTo, Protected) at the point the trait is being solved + abstract AccessRights: ITraitAccessorDomain + +/// Only satisfied by elsewhere. Not stored in TastPickle. +type ITraitExtensionMember = interface end + +type ITraitAccessorDomain = interface end + +/// Represents the specification of a member constraint that must be solved [] type TraitWitnessInfo = @@ -2389,30 +2407,38 @@ type TraitWitnessInfo = [] type TraitConstraintInfo = + /// TTrait(tys, nm, memFlags, argtys, rty, solutionCell, extSlns, ad) + /// /// Indicates the signature of a member constraint. Contains a mutable solution cell /// to store the inferred solution of the constraint. - | TTrait of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * solution: TraitConstraintSln option ref + | TTrait of supportTys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * solution: TraitConstraintSln option ref * traitContext: ITraitContext option /// Get the types that may provide solutions for the traits - member x.SupportTypes = (let (TTrait(tys, _, _, _, _, _)) = x in tys) + member x.SupportTypes = (let (TTrait(tys, _, _, _, _, _, _)) = x in tys) + + /// Get the key associated with the member constraint. + member x.TraitKey = (let (TTrait(a, b, c, d, e, _, _)) = x in TraitWitnessInfo(a, b, c, d, e)) /// Get the logical member name associated with the member constraint. - member x.MemberLogicalName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) + member x.MemberLogicalName = (let (TTrait(_, nm, _, _, _, _, _)) = x in nm) /// Get the member flags associated with the member constraint. - member x.MemberFlags = (let (TTrait(_, _, flags, _, _, _)) = x in flags) + member x.MemberFlags = (let (TTrait(_, _, flags, _, _, _, _)) = x in flags) - member x.CompiledObjectAndArgumentTypes = (let (TTrait(_, _, _, objAndArgTys, _, _)) = x in objAndArgTys) + member x.CompiledObjectAndArgumentTypes = (let (TTrait(_, _, _, objAndArgTys, _, _, _)) = x in objAndArgTys) - member x.WithMemberKind(kind) = (let (TTrait(a, b, c, d, e, f)) = x in TTrait(a, b, { c with MemberKind=kind }, d, e, f)) + member x.WithMemberKind(kind) = (let (TTrait(a, b, c, d, e, f, g)) = x in TTrait(a, b, { c with MemberKind=kind }, d, e, f, g)) /// Get the optional return type recorded in the member constraint. - member x.CompiledReturnType = (let (TTrait(_, _, _, _, retTy, _)) = x in retTy) + member x.CompiledReturnType = (let (TTrait(_, _, _, _, retTy, _, _)) = x in retTy) /// Get or set the solution of the member constraint during inference member x.Solution - with get() = (let (TTrait(_, _, _, _, _, sln)) = x in sln.Value) - and set v = (let (TTrait(_, _, _, _, _, sln)) = x in sln.Value <- v) + with get() = (let (TTrait(_, _, _, _, _, sln, _)) = x in sln.Value) + and set v = (let (TTrait(_, _, _, _, _, sln, _)) = x in sln.Value <- v) + + /// Get the context used to help determine possible extension member solutions + member x.TraitContext = (let (TTrait(_, _, _, _, _, _, traitCtxt)) = x in traitCtxt) [] member x.DebugText = x.ToString() @@ -2426,11 +2452,12 @@ type TraitConstraintSln = /// FSMethSln(ty, vref, minst) /// /// Indicates a trait is solved by an F# method. - /// ty -- the type and its instantiation - /// vref -- the method that solves the trait constraint - /// minst -- the generic method instantiation + /// apparentType -- the apparent type and its instantiation + /// valRef -- the method that solves the trait constraint + /// methodInst -- the generic method instantiation /// staticTyOpt -- the static type governing a static virtual call, if any - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option + /// isExt -- is this a use of an extension method + | FSMethSln of apparentType: TType * valRef: ValRef * methodInst: TypeInst * staticTyOpt: TType option * isExt: bool /// FSRecdFieldSln(tinst, rfref, isSetProp) /// diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index b63942d2c8c..5903b3245d6 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1649,6 +1649,26 @@ type TraitWitnessInfo = /// Get the return type recorded in the member constraint. member ReturnType: TType option +/// Represents the ability to solve traits via extension methods in a particular scope. +/// +/// Only satisfied by types defined elsewhere (e.g. NameResolutionEnv), and not stored in TypedTreePickle. +type ITraitContext = + /// Used to select the extension methods in the context relevant to solving the constraint + /// given the current support types + abstract SelectExtensionMethods: TraitConstraintInfo * range * infoReader: obj -> (TType * ITraitExtensionMember) list + + /// Gives the access rights (e.g. InternalsVisibleTo, Protected) at the point the trait is being solved + abstract AccessRights: ITraitAccessorDomain + +/// Only satisfied by elsewhere. Not stored in TastPickle. +type ITraitExtensionMember = + interface + end + +type ITraitAccessorDomain = + interface + end + /// The specification of a member constraint that must be solved [] type TraitConstraintInfo = @@ -1656,12 +1676,13 @@ type TraitConstraintInfo = /// Indicates the signature of a member constraint. Contains a mutable solution cell /// to store the inferred solution of the constraint. | TTrait of - tys: TTypes * + supportTys: TTypes * memberName: string * memberFlags: Syntax.SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * - solution: TraitConstraintSln option ref + solution: TraitConstraintSln option ref * + traitContext: ITraitContext option override ToString: unit -> string @@ -1691,6 +1712,12 @@ type TraitConstraintInfo = /// Get or set the solution of the member constraint during inference member Solution: TraitConstraintSln option with get, set + /// Get the context used to help determine possible extension member solutions + member TraitContext: ITraitContext option + + /// Get the key associated with the member constraint. + member TraitKey: TraitWitnessInfo + /// The member kind is irrelevant to the logical properties of a trait. However it adjusts /// the extension property MemberDisplayNameCore member WithMemberKind: SynMemberKind -> TraitConstraintInfo @@ -1702,11 +1729,12 @@ type TraitConstraintSln = /// FSMethSln(ty, vref, minst) /// /// Indicates a trait is solved by an F# method. - /// ty -- the type type its instantiation - /// vref -- the method that solves the trait constraint + /// apparentType -- the apparent type and its instantiation + /// valRef -- the method that solves the trait constraint + /// methodInst -- the generic method instantiation /// staticTyOpt -- the static type governing a static virtual call, if any - /// minst -- the generic method instantiation - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option + /// isExt -- is this a use of an extension method + | FSMethSln of apparentType: TType * valRef: ValRef * methodInst: TypeInst * staticTyOpt: TType option * isExt: bool /// FSRecdFieldSln(tinst, rfref, isSetProp) /// diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f57954f7bf5..0bcd81a53a8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -111,13 +111,17 @@ type Remap = tyconRefRemap: TyconRefRemap /// Remove existing trait solutions? - removeTraitSolutions: bool } + removeTraitSolutions: bool + + /// A map indicating how to fill in extSlns for traits as we copy an expression. Indexed by the member name of the trait + traitCtxtsMap: Map } let emptyRemap = { tpinst = emptyTyparInst tyconRefRemap = emptyTyconRefRemap valRemap = ValMap.Empty - removeTraitSolutions = false } + removeTraitSolutions = false + traitCtxtsMap = Map.empty } type Remap with static member Empty = emptyRemap @@ -276,7 +280,7 @@ and remapTraitWitnessInfo tyenv (TraitWitnessInfo(tys, nm, flags, argTys, retTy) let rtyR = Option.map (remapTypeAux tyenv) retTy TraitWitnessInfo(tysR, nm, flags, argTysR, rtyR) -and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = +and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell, traitCtxt)) = let slnCell = match slnCell.Value with | None -> None @@ -286,8 +290,8 @@ and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = match sln with | ILMethSln(ty, extOpt, ilMethRef, minst, staticTyOpt) -> ILMethSln(remapTypeAux tyenv ty, extOpt, ilMethRef, remapTypesAux tyenv minst, Option.map (remapTypeAux tyenv) staticTyOpt) - | FSMethSln(ty, vref, minst, staticTyOpt) -> - FSMethSln(remapTypeAux tyenv ty, remapValRef tyenv vref, remapTypesAux tyenv minst, Option.map (remapTypeAux tyenv) staticTyOpt) + | FSMethSln(ty, vref, minst, staticTyOpt, isExt) -> + FSMethSln(remapTypeAux tyenv ty, remapValRef tyenv vref, remapTypesAux tyenv minst, Option.map (remapTypeAux tyenv) staticTyOpt, isExt) | FSRecdFieldSln(tinst, rfref, isSet) -> FSRecdFieldSln(remapTypesAux tyenv tinst, remapRecdFieldRef tyenv.tyconRefRemap rfref, isSet) | FSAnonRecdFieldSln(anonInfo, tinst, n) -> @@ -297,7 +301,13 @@ and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = | ClosedExprSln e -> ClosedExprSln e // no need to remap because it is a closed expression, referring only to external types Some sln - + + let traitCtxtNew = + if tyenv.traitCtxtsMap.ContainsKey nm then + Some tyenv.traitCtxtsMap[nm] + else + traitCtxt + let tysR = remapTypesAux tyenv tys let argTysR = remapTypesAux tyenv argTys let retTyR = Option.map (remapTypeAux tyenv) retTy @@ -312,7 +322,7 @@ and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = // in the same way as types let newSlnCell = ref slnCell - TTrait(tysR, nm, flags, argTysR, retTyR, newSlnCell) + TTrait(tysR, nm, flags, argTysR, retTyR, newSlnCell, traitCtxtNew) and bindTypars tps tyargs tpinst = match tps with @@ -405,7 +415,8 @@ let mkInstRemap tpinst = { tyconRefRemap = emptyTyconRefRemap tpinst = tpinst valRemap = ValMap.Empty - removeTraitSolutions = false } + removeTraitSolutions = false + traitCtxtsMap = Map.empty } // entry points for "typar -> TType" instantiation let instType tpinst x = if isNil tpinst then x else remapTypeAux (mkInstRemap tpinst) x @@ -415,7 +426,6 @@ let instTyparConstraints tpinst x = if isNil tpinst then x else remapTyparConstr let instSlotSig tpinst ss = remapSlotSig (fun _ -> []) (mkInstRemap tpinst) ss let copySlotSig ss = remapSlotSig (fun _ -> []) Remap.Empty ss - let mkTyparToTyparRenaming tpsorig tps = let tinst = generalizeTypars tps mkTyparInst tpsorig tinst, tinst @@ -969,8 +979,8 @@ type TypeEquivEnv with TypeEquivEnv.Empty.BindEquivTypars tps1 tps2 let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = - let (TTrait(tys1, nm, mf1, argTys, retTy, _)) = traitInfo1 - let (TTrait(tys2, nm2, mf2, argTys2, retTy2, _)) = traitInfo2 + let (TTrait(tys1, nm, mf1, argTys, retTy, _, _)) = traitInfo1 + let (TTrait(tys2, nm2, mf2, argTys2, retTy2, _, _)) = traitInfo2 mf1.IsInstance = mf2.IsInstance && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && @@ -2264,7 +2274,7 @@ and accFreeInTyparConstraint opts tpc acc = | TyparConstraint.IsUnmanaged _ | TyparConstraint.RequiresDefaultConstructor _ -> acc -and accFreeInTrait opts (TTrait(tys, _, _, argTys, retTy, sln)) acc = +and accFreeInTrait opts (TTrait(tys, _, _, argTys, retTy, sln, _)) acc = Option.foldBack (accFreeInTraitSln opts) sln.Value (accFreeInTypes opts tys (accFreeInTypes opts argTys @@ -2281,7 +2291,7 @@ and accFreeInTraitSln opts sln acc = Option.foldBack (accFreeInType opts) staticTyOpt (accFreeInType opts ty (accFreeInTypes opts minst acc)) - | FSMethSln(ty, vref, minst, staticTyOpt) -> + | FSMethSln(ty, vref, minst, staticTyOpt, _isExt) -> Option.foldBack (accFreeInType opts) staticTyOpt (accFreeInType opts ty (accFreeValRefInTraitSln opts vref @@ -2404,7 +2414,7 @@ and accFreeInTyparConstraintLeftToRight g cxFlag thruFlag acc tpc = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> acc -and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(tys, _, _, argTys, retTy, _)) = +and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(tys, _, _, argTys, retTy, _, _traitCtxt)) = let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc tys let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc argTys let acc = Option.fold (accFreeInTypeLeftToRight g cxFlag thruFlag) acc retTy @@ -2473,6 +2483,53 @@ let valOfBind (b: Binding) = b.Var let valsOfBinds (binds: Bindings) = binds |> List.map (fun b -> b.Var) +//-------------------------------------------------------------------------- +// Collect extSlns. This is done prior to beta reduction of type parameters when inlining. We take the (solved) +// type arguments and strip them for trait contexts, and use those in the remapped/copied/instantiated body +// of the implementation. +//-------------------------------------------------------------------------- + +let rec accTraitCtxtsInTyparConstraints acc cxs = + List.fold accTraitCtxtsInTyparConstraint acc cxs + +and accTraitCtxtsInTyparConstraint acc tpc = + match tpc with + | TyparConstraint.MayResolveMember (traitInfo, _) -> accTraitCtxtsInTrait acc traitInfo + | _ -> acc + +and accTraitCtxtsInTrait acc (TTrait(_typs, nm, _, _argtys, _rty, _, traitCtxt)) = + // We don't traverse the contents of traits, that wouldn't terminate and is not necessary since the type variables individiually contain the contexts we need + //let acc = accTraitCtxtsInTypes g acc typs + //let acc = accTraitCtxtsInTypes g acc argtys + //let acc = Option.fold (accTraitCtxtsInType g) acc rty + // Only record the extSlns if they have been solved in a useful way + match traitCtxt with + | None -> acc + | Some c -> Map.add nm c acc + +and accTraitCtxtsTyparRef acc (tp:Typar) = + let acc = accTraitCtxtsInTyparConstraints acc tp.Constraints + match tp.Solution with + | None -> acc + | Some sln -> accTraitCtxtsInType acc sln + +and accTraitCtxtsInType acc ty = + // NOTE: Unlike almost everywhere else, we do NOT strip ANY equations here. + // We _must_ traverse the solved typar containing the new extSlns for the grounded typar constraint, that's the whole point + match ty with + | TType_tuple (_, tys) + | TType_anon (_, tys) + | TType_app (_, tys, _) + | TType_ucase (_, tys) -> accTraitCtxtsInTypes acc tys + | TType_fun (d, r, _) -> accTraitCtxtsInType (accTraitCtxtsInType acc d) r + | TType_var (r, _) -> accTraitCtxtsTyparRef acc r + | TType_forall (_tps, r) -> accTraitCtxtsInType acc r + | TType_measure unt -> List.foldBack (fun (tp, _) acc -> accTraitCtxtsTyparRef acc tp) (ListMeasureVarOccsWithNonZeroExponents unt) acc + +and accTraitCtxtsInTypes acc tys = (acc, tys) ||> List.fold accTraitCtxtsInType + +let traitCtxtsInTypes tys = accTraitCtxtsInTypes Map.empty tys + //-------------------------------------------------------------------------- // Values representing member functions on F# types //-------------------------------------------------------------------------- @@ -2611,7 +2668,7 @@ type TraitConstraintInfo with /// Get the key associated with the member constraint. member traitInfo.GetWitnessInfo() = - let (TTrait(tys, nm, memFlags, objAndArgTys, rty, _)) = traitInfo + let (TTrait(tys, nm, memFlags, objAndArgTys, rty, _, _)) = traitInfo TraitWitnessInfo(tys, nm, memFlags, objAndArgTys, rty) /// Get information about the trait constraints for a set of typars. @@ -3982,7 +4039,7 @@ module DebugPrint = and auxTraitL env (ttrait: TraitConstraintInfo) = #if DEBUG - let (TTrait(tys, nm, memFlags, argTys, retTy, _)) = ttrait + let (TTrait(tys, nm, memFlags, argTys, retTy, _, _traitCtxt)) = ttrait match global_g with | None -> wordL (tagText "") | Some g -> @@ -4649,7 +4706,8 @@ let mkRepackageRemapping mrpi = { valRemap = ValMap.OfList (mrpi.RepackagedVals |> List.map (fun (vref, x) -> vref.Deref, x)) tpinst = emptyTyparInst tyconRefRemap = TyconRefMap.OfList mrpi.RepackagedEntities - removeTraitSolutions = false } + removeTraitSolutions = false + traitCtxtsMap = Map.empty } //-------------------------------------------------------------------------- // Compute instances of the above for mty -> mty @@ -5327,7 +5385,7 @@ and accFreeInOp opts op acc = | TOp.Reraise -> accUsesRethrow true acc - | TOp.TraitCall (TTrait(tys, _, _, argTys, retTy, sln)) -> + | TOp.TraitCall (TTrait(tys, _, _, argTys, retTy, sln, _traitCtxt)) -> Option.foldBack (accFreeVarsInTraitSln opts) sln.Value (accFreeVarsInTys opts tys (accFreeVarsInTys opts argTys @@ -6287,8 +6345,10 @@ let copyImplFile g compgen e = remapImplFile ctxt compgen Remap.Empty e |> fst let instExpr g tpinst e = - let ctxt = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } - remapExprImpl ctxt CloneAll (mkInstRemap tpinst) e + let traitCtxtsMap = traitCtxtsInTypes (List.map snd tpinst) + let ctxt : RemapContext = { g = g; stackGuard = StackGuard(RemapExprStackGuardDepth, "RemapExprStackGuardDepth") } + let remap = { mkInstRemap tpinst with traitCtxtsMap = traitCtxtsMap } + remapExprImpl ctxt CloneAll remap e //-------------------------------------------------------------------------- // Replace Marks - adjust debugging marks when a lambda gets @@ -8326,7 +8386,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let curriedInputTys, _ = stripFunTy g inputTy - assert (curriedActualArgTys.Length = curriedInputTys.Length) + if curriedActualArgTys.Length <> curriedInputTys.Length then None else let argTys = (curriedInputTys, curriedActualArgTys) ||> List.mapi2 (fun i x y -> (i, x, y)) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 00d838e04d4..adec3aef006 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -550,10 +550,21 @@ type ValRemap = ValMap /// Represents a combination of substitutions/instantiations where things replace other things during remapping [] type Remap = - { tpinst: TyparInstantiation - valRemap: ValRemap - tyconRefRemap: TyconRefRemap - removeTraitSolutions: bool } + { + tpinst: TyparInstantiation + + /// Values to remap + valRemap: ValRemap + + /// TyconRefs to remap + tyconRefRemap: TyconRefRemap + + /// Remove existing trait solutions? + removeTraitSolutions: bool + + /// A map indicating how to fill in trait contexts for traits as we copy an expression. Indexed by the member name of the trait + traitCtxtsMap: Map + } static member Empty: Remap @@ -1585,6 +1596,10 @@ type TypeDefMetadata = /// Extract metadata from a type definition val metadataOfTycon: Tycon -> TypeDefMetadata +#if EXTENSIONTYPING +val extensionInfoOfTy: TcGlobals -> TType -> TyconRepresentation +#endif + /// Extract metadata from a type val metadataOfTy: TcGlobals -> TType -> TypeDefMetadata diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 90fd15fa1e2..5d433fdcc32 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1514,8 +1514,8 @@ let p_trait_sln sln st = match sln with | ILMethSln(a, b, c, d, None) -> p_byte 0 st; p_tup4 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys (a, b, c, d) st - | FSMethSln(a, b, c, None) -> - p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a, b, c) st + | FSMethSln(a, b, c, None, false) -> + p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a, b, c) st | BuiltInSln -> p_byte 2 st | ClosedExprSln expr -> @@ -1526,11 +1526,13 @@ let p_trait_sln sln st = p_byte 5 st; p_tup3 p_anonInfo p_tys p_int (a, b, c) st | ILMethSln(a, b, c, d, Some e) -> p_byte 6 st; p_tup5 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys p_ty (a, b, c, d, e) st - | FSMethSln(a, b, c, Some d) -> + | FSMethSln(a, b, c, Some d, false) -> p_byte 7 st; p_tup4 p_ty (p_vref "trait") p_tys p_ty (a, b, c, d) st + | FSMethSln(a, b, c, d, true) -> + p_byte 8 st; p_tup4 p_ty (p_vref "trait") p_tys (p_option p_ty) (a, b, c, d) st -let p_trait (TTrait(a, b, c, d, e, f)) st = +let p_trait (TTrait(a, b, c, d, e, f, _traitCtxt)) st = p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, f.Value) st let u_anonInfo_data st = @@ -1549,7 +1551,7 @@ let u_trait_sln st = ILMethSln(a, b, c, d, None) | 1 -> let a, b, c = u_tup3 u_ty u_vref u_tys st - FSMethSln(a, b, c, None) + FSMethSln(a, b, c, None, false) | 2 -> BuiltInSln | 3 -> @@ -1565,13 +1567,18 @@ let u_trait_sln st = ILMethSln(a, b, c, d, Some e) | 7 -> let a, b, c, d = u_tup4 u_ty u_vref u_tys u_ty st - FSMethSln(a, b, c, Some d) + FSMethSln(a, b, c, Some d, false) + | 8 -> + let a, b, c, d = u_tup4 u_ty u_vref u_tys (u_option u_ty) st + FSMethSln(a, b, c, d, true) | _ -> ufailwith st "u_trait_sln" let u_trait st = let a, b, c, d, e, f = u_tup6 u_tys u_string u_MemberFlags u_tys (u_option u_ty) (u_option u_trait_sln) st - TTrait (a, b, c, d, e, ref f) - + // extSlns starts empty when reading trait constraints from pickled + // data. This is ok as only generalized (pre-solution, pre-freshened) + // or solved constraints are propagated across assembly boundaries. + TTrait (a, b, c, d, e, ref f, None) let p_rational q st = p_int32 (GetNumerator q) st; p_int32 (GetDenominator q) st diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index a7c98422756..2788e3b5713 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -13,7 +13,6 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers @@ -21,7 +20,6 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps -open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 2d981896ab9..7a0443cad1a 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -172,6 +172,11 @@ literál float32 bez tečky + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute chyba při zastaralém přístupu konstruktoru s atributem RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Žádný z typů {0} nepodporuje operátor {1}. + The types '{0}' do not support the operator '{1}' + Žádný z typů {0} nepodporuje operátor {1}. @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Žádný z typů {0} nepodporuje operátor {1}. Zvažte otevření modulu Microsoft.FSharp.Linq.NullableOperators. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Žádný z typů {0} nepodporuje operátor {1}. Zvažte otevření modulu Microsoft.FSharp.Linq.NullableOperators. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 7b2e86ccd81..0da3c69e894 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -172,6 +172,11 @@ punktloses float32-Literal + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute Beim veralteten Zugriff auf das Konstrukt mit dem RequireQualifiedAccess-Attribut wird ein Fehler ausgegeben. @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Der Operator '{1}' wird von keinem der Typen '{0}' unterstützt + The types '{0}' do not support the operator '{1}' + Der Operator '{1}' wird von keinem der Typen '{0}' unterstützt @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Der Operator '{1}' wird von keinem der Typen '{0}' unterstützt. Möglicherweise sollte das Modul 'Microsoft.FSharp.Linq.NullableOperators' geöffnet werden. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Der Operator '{1}' wird von keinem der Typen '{0}' unterstützt. Möglicherweise sollte das Modul 'Microsoft.FSharp.Linq.NullableOperators' geöffnet werden. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 8aad3d6f781..aaa937dcc9a 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -172,6 +172,11 @@ literal float32 sin punto + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute error en el acceso en desuso de la construcción con el atributo RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Ninguno de los tipos '{0}' admite el operador '{1}' + The types '{0}' do not support the operator '{1}' + Ninguno de los tipos '{0}' admite el operador '{1}' @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Ninguno de los tipos '{0}' admite el operador '{1}'. Considere abrir el módulo 'Microsoft.FSharp.Linq.NullableOperators'. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Ninguno de los tipos '{0}' admite el operador '{1}'. Considere abrir el módulo 'Microsoft.FSharp.Linq.NullableOperators'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index ffc5e832198..6ee8de9c53e 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -172,6 +172,11 @@ littéral float32 sans point + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute donner une erreur sur l’accès déconseillé de la construction avec l’attribut RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Aucun des types '{0}' ne prend en charge l'opérateur '{1}' + The types '{0}' do not support the operator '{1}' + Aucun des types '{0}' ne prend en charge l'opérateur '{1}' @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Aucun des types '{0}' ne prend en charge l'opérateur '{1}'. Envisagez d'ouvrir le module 'Microsoft.FSharp.Linq.NullableOperators'. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Aucun des types '{0}' ne prend en charge l'opérateur '{1}'. Envisagez d'ouvrir le module 'Microsoft.FSharp.Linq.NullableOperators'. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 29240e0d98c..1c83211ffc3 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -172,6 +172,11 @@ valore letterale float32 senza punti + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute errore durante l'accesso deprecato del costrutto con l'attributo RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Nessuno dei tipi '{0}' supporta l'operatore '{1}' + The types '{0}' do not support the operator '{1}' + Nessuno dei tipi '{0}' supporta l'operatore '{1}' @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Nessun tipo '{0}' supporta l'operatore '{1}'. Provare ad aprire il modulo 'Microsoft.FSharp.Linq.NullableOperators'. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Nessun tipo '{0}' supporta l'operatore '{1}'. Provare ad aprire il modulo 'Microsoft.FSharp.Linq.NullableOperators'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index c509bc1328e..9a34fe621c6 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -187,6 +187,11 @@ 固定インデックス スライス 3d/4d + + extension constraint solutions + extension constraint solutions + + from-end slicing 開始と終了を指定したスライス @@ -2227,6 +2232,16 @@ {0}' はプレフィックスの '{1}' フラグをサポートしていません + + The types '{0}' do not support the operator '{1}' + The types '{0}' do not support the operator '{1}' + + + + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + + Bad format specifier: '{0}' 書式指定子に誤りがあります:'{0}' @@ -2577,21 +2592,11 @@ 演算子 '{0}' をサポートする型が必要ですが、タプル型が指定されました - - None of the types '{0}' support the operator '{1}' - 型 '{0}' はいずれも演算子 '{1}' をサポートしていません - - The type '{0}' does not support the operator '{1}' 型 '{0}' は演算子 '{1}' をサポートしていません - - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - 型 '{0}' はいずれも演算子 '{1}' をサポートしていません。'Microsoft.FSharp.Linq.NullableOperators' モジュールを開いてください。 - - The type '{0}' does not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. 型 '{0}' は演算子 '{1}' をサポートしていません。'Microsoft.FSharp.Linq.NullableOperators' モジュールを開いてください。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 9767ff521a6..1ca7e293996 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -172,6 +172,11 @@ 점이 없는 float32 리터럴 + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute RequireQualifiedAccess 특성을 사용하여 사용되지 않는 구문 액세스에 대한 오류 제공 @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - {0}' 형식에서 '{1}' 연산자를 지원하지 않습니다. + The types '{0}' do not support the operator '{1}' + {0}' 형식에서 '{1}' 연산자를 지원하지 않습니다. @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - {0}' 형식에서 '{1}' 연산자를 지원하지 않습니다. 'Microsoft.FSharp.Linq.NullableOperators' 모듈을 열어 보세요. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + {0}' 형식에서 '{1}' 연산자를 지원하지 않습니다. 'Microsoft.FSharp.Linq.NullableOperators' 모듈을 열어 보세요. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 4a565f29eaf..5994f981ed2 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -172,6 +172,11 @@ bezkropkowy literał float32 + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute wskazywanie błędu w przypadku przestarzałego dostępu do konstrukcji z atrybutem RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Żaden z typów „{0}” nie obsługuje operatora „{1}” + The types '{0}' do not support the operator '{1}' + Żaden z typów „{0}” nie obsługuje operatora „{1}” @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Żaden z typów „{0}” nie obsługuje operatora „{1}”. Rozważ otwarcie modułu „Microsoft.FSharp.Linq.NullableOperators”. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Żaden z typów „{0}” nie obsługuje operatora „{1}”. Rozważ otwarcie modułu „Microsoft.FSharp.Linq.NullableOperators”. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 140f330414d..98c07d52c2c 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -172,6 +172,11 @@ literal float32 sem ponto + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute fornecer erro no acesso preterido do constructo com o atributo RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Nenhum dos tipos '{0}' oferece suporte ao operador '{1}' + The types '{0}' do not support the operator '{1}' + Nenhum dos tipos '{0}' oferece suporte ao operador '{1}' @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Nenhum dos tipos '{0}' oferece suporte ao operador '{1}'. Considere abrir o módulo 'Microsoft.FSharp.Linq.NullableOperators'. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Nenhum dos tipos '{0}' oferece suporte ao operador '{1}'. Considere abrir o módulo 'Microsoft.FSharp.Linq.NullableOperators'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 5c8c1ad44e7..fd4ba080ccb 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -172,6 +172,11 @@ литерал float32 без точки + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute выдать ошибку при устаревшем доступе к конструкции с атрибутом RequireQualifiedAccess @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - Ни один из типов "{0}" не поддерживает оператор "{1}" + The types '{0}' do not support the operator '{1}' + Ни один из типов "{0}" не поддерживает оператор "{1}" @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - Ни один из типов "{0}" не поддерживает оператор "{1}". Попробуйте открыть модуль Microsoft.FSharp.Linq.NullableOperators. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + Ни один из типов "{0}" не поддерживает оператор "{1}". Попробуйте открыть модуль Microsoft.FSharp.Linq.NullableOperators. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index fb8d5406e68..7ad71cb6a00 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -172,6 +172,11 @@ noktasız float32 sabit değeri + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute RequireQualifiedAccess özniteliğine sahip yapının kullanım dışı erişiminde hata @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - {0}' türlerinin hiçbiri '{1}' işlecini desteklemez + The types '{0}' do not support the operator '{1}' + {0}' türlerinin hiçbiri '{1}' işlecini desteklemez @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - {0}' türlerinin hiçbiri '{1}' işlecini desteklemez. 'Microsoft.FSharp.Linq.NullableOperators' modülünü açmayı düşünün. + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + {0}' türlerinin hiçbiri '{1}' işlecini desteklemez. 'Microsoft.FSharp.Linq.NullableOperators' modülünü açmayı düşünün. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index baf4e53d041..df6a9e6c846 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -172,6 +172,11 @@ 无点 float32 文本 + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute 对具有 RequireQualifiedAccess 属性的构造进行弃用的访问时出错 @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - 任何类型“{0}”都不支持运算符“{1}” + The types '{0}' do not support the operator '{1}' + 任何类型“{0}”都不支持运算符“{1}” @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - 任何类型“{0}”都不支持运算符“{1}”。请考虑打开模块“Microsoft.FSharp.Linq.NullableOperators”。 + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + 任何类型“{0}”都不支持运算符“{1}”。请考虑打开模块“Microsoft.FSharp.Linq.NullableOperators”。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 3711de1d214..77e4e6ead7c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -172,6 +172,11 @@ 無點號的 float32 常值 + + extension constraint solutions + extension constraint solutions + + give error on deprecated access of construct with RequireQualifiedAccess attribute 對具有 RequireQualifiedAccess 屬性的建構的已取代存取發出錯誤 @@ -2578,8 +2583,8 @@ - None of the types '{0}' support the operator '{1}' - 類型 '{0}' 都不支援運算子 '{1}' + The types '{0}' do not support the operator '{1}' + 類型 '{0}' 都不支援運算子 '{1}' @@ -2588,8 +2593,8 @@ - None of the types '{0}' support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. - 類型 '{0}' 都不支援運算子 '{1}'。請考慮開啟模組 'Microsoft.FSharp.Linq.NullableOperators'。 + The types '{0}' do not support the operator '{1}'. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. + 類型 '{0}' 都不支援運算子 '{1}'。請考慮開啟模組 'Microsoft.FSharp.Linq.NullableOperators'。 diff --git a/src/FSharp.Core/prim-types.fs b/src/FSharp.Core/prim-types.fs index a3019b1ec84..ffa327faf45 100644 --- a/src/FSharp.Core/prim-types.fs +++ b/src/FSharp.Core/prim-types.fs @@ -83,6 +83,11 @@ namespace Microsoft.FSharp.Core member _.Value = value new () = new AllowNullLiteralAttribute(true) + [] + [] + type AllowOverloadByReturnTypeAttribute() = + inherit System.Attribute() + [] [] type VolatileFieldAttribute() = diff --git a/src/FSharp.Core/prim-types.fsi b/src/FSharp.Core/prim-types.fsi index e639f3cb85e..6ad66a5b131 100644 --- a/src/FSharp.Core/prim-types.fsi +++ b/src/FSharp.Core/prim-types.fsi @@ -279,6 +279,16 @@ namespace Microsoft.FSharp.Core /// The value of the attribute, indicating whether the type allows the null literal or not member Value: bool + /// Adding this attribute to a method allows that method to be overloaded by return type. + [] + [] + type AllowOverloadByReturnTypeAttribute = + inherit Attribute + + /// Creates an instance of the attribute + /// AllowOverloadByReturnTypeAttribute + new : unit -> AllowOverloadByReturnTypeAttribute + /// Adding this attribute to a value causes it to be compiled as a CLI constant literal. /// /// Attributes diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/BindingExpressions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/BindingExpressions.fs index 89b2383dd86..5be6236d1cd 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/BindingExpressions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/BindingExpressions.fs @@ -105,8 +105,8 @@ module BindingExpressions = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 1, Line 12, Col 13, Line 12, Col 14, "The type 'int' does not match the type 'unit'") - (Error 1, Line 12, Col 18, Line 12, Col 24, "Type mismatch. Expecting a\n ''a -> 'b' \nbut given a\n ''a -> unit' \nThe type 'int' does not match the type 'unit'") + (Error 1, Line 12, Col 13, Line 12, Col 14, "The types 'unit, int' do not support the operator '+'") + (Error 1, Line 12, Col 18, Line 12, Col 24, "The types 'unit, int' do not support the operator '+'") (Warning 20, Line 13, Col 5, Line 13, Col 10, "The result of this expression has type 'bool' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'.") ] @@ -118,8 +118,8 @@ module BindingExpressions = |> compile |> shouldFail |> withDiagnostics [ - (Error 1, Line 10, Col 9, Line 10, Col 10, "The type 'int' does not match the type 'unit'") - (Error 1, Line 10, Col 14, Line 10, Col 20, "Type mismatch. Expecting a\n ''a -> 'b' \nbut given a\n ''a -> unit' \nThe type 'int' does not match the type 'unit'") + (Error 1, Line 10, Col 9, Line 10, Col 10, "The types 'unit, int' do not support the operator '+'") + (Error 1, Line 10, Col 14, Line 10, Col 20, "The types 'unit, int' do not support the operator '+'") ] // SOURCE=MutableLocals01.fs SCFLAGS="--warnon:3180 --optimize+ --test:ErrorRanges" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fs index 583f27de4e8..63ab728ec72 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fs @@ -3,8 +3,8 @@ // These are pretty pathological cases related to ";;" and "in" // I'm adding these cases to make sure we do not accidentally change the behavior from version to version // Eventually, we will deprecated them - and the specs will be updated. -//The type 'int' does not match the type 'unit'$ -//Type mismatch\. Expecting a. ''a -> 'b' .but given a. ''a -> unit' .The type 'int' does not match the type 'unit'$ +//The types 'unit, int' do not support the operator +//The types 'unit, int' do not support the operator //The result of this expression has type 'bool' and is implicitly ignored\. Consider using 'ignore' to discard this value explicitly, e\.g\. 'expr \|> ignore', or 'let' to bind the result to a name, e\.g\. 'let result = expr'.$ module E let a = 3 in diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fsx b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fsx index 2b8f8265d99..b6f62042f92 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fsx +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/Expressions/BindingExpressions/in05.fsx @@ -3,7 +3,7 @@ // These are pretty pathological cases related to ";;" and "in" // I'm adding these cases to make sure we do not accidentally change the behavior from version to version // Eventually, we will deprecated them - and the specs will be updated. -//The type 'int' does not match the type 'unit'$ +//The types 'unit, int' do not support the operator let a = 3 in a + 1 |> ignore diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.fs index 95d9db63cae..f833c7063b7 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.fs @@ -711,6 +711,7 @@ Microsoft.FSharp.Core.AllowNullLiteralAttribute: Boolean Value Microsoft.FSharp.Core.AllowNullLiteralAttribute: Boolean get_Value() Microsoft.FSharp.Core.AllowNullLiteralAttribute: Void .ctor() Microsoft.FSharp.Core.AllowNullLiteralAttribute: Void .ctor(Boolean) +Microsoft.FSharp.Core.AllowOverloadByReturnTypeAttribute: Void .ctor() Microsoft.FSharp.Core.AutoOpenAttribute: System.String Path Microsoft.FSharp.Core.AutoOpenAttribute: System.String get_Path() Microsoft.FSharp.Core.AutoOpenAttribute: Void .ctor() diff --git a/tests/fsharp/core/extconstraint/cslib.cs b/tests/fsharp/core/extconstraint/cslib.cs new file mode 100644 index 00000000000..baad200998d --- /dev/null +++ b/tests/fsharp/core/extconstraint/cslib.cs @@ -0,0 +1,13 @@ + +// TODO add extension members here + +public struct S { + public int x; +} + +public class Class1 +{ + public string myField; + public readonly string myReadonlyField; + public Class1(string v) { this.myReadonlyField = v; } +} diff --git a/tests/fsharp/core/extconstraint/test-compat.fsx b/tests/fsharp/core/extconstraint/test-compat.fsx new file mode 100644 index 00000000000..6b80b841754 --- /dev/null +++ b/tests/fsharp/core/extconstraint/test-compat.fsx @@ -0,0 +1,104 @@ + +// We compile this and check the inferred signature against a baseline. +// The baseline is manually generated from a previous-generated F# compiler. + +module TestCompat + +module CheckNewOverloadsDoneConfusePreviousCode = + open System + + type System.DateTime with + static member (+)(a: DateTime, b: TimeSpan) = a + + let x = DateTime.Now + TimeSpan.Zero + let f1 (x: DateTime) = x + TimeSpan.Zero + let f2 (x: TimeSpan) y = y + x + let f3 x y = DateTime.op_Addition (x, y) + let f4 x y = TimeSpan.op_Addition (x, y) + + +module CheckNewOverloadsDoneConfusePreviousCode2 = + open System + open System.Numerics + + // This adds one op_Addition overload to a type that currently only has one op_Addition overload + type System.Numerics.Complex with + static member (+)(a: Complex, b: TimeSpan) = a + + type CheckNominal() = + static member CanResolveOverload(x: TimeSpan) = () + static member CanResolveOverload(x: Complex) = () + + // Next check we can resolve direct calls to the op_Addition overload both to new and old types. + // There is nothing new here, no SRTP constraints involved. + let f1 (x: Complex) (y: Complex) = System.Numerics.Complex.op_Addition (x, y) + let f2 (x: Complex) (y: TimeSpan) = System.Numerics.Complex.op_Addition (x, y) + + // Next check we can resolve the op_Addition overload with no type information. + // This in F# overload resolution the original method is preferred to the extension method. + // There is nothing new here, no SRTP constraints involved. + let f3 x y = System.Numerics.Complex.op_Addition (x, y) + + // Next check we can resolve the SRTP constraint implied by the use of the + // '+' operator when given two argument types (no return type) + let f4 (x: Complex) (y: Complex) = x + y + +#if LANGVERSION_PREVIEW + // Next check we can resolve the SRTP constraint implied by the use of the + // '+' operator when given two argument types (no return type), resolving to the + // extension member. + let f5 (x: Complex) (y: TimeSpan) = x + y +#endif + + // Next check we can resolve the SRTP constraint implied by the use of the + // '+' operator when given only the first argument type. This must resolve to the original + // overload. + // + // The original overload is preferred to the extension overload. + // + // Note the SRTP constraint is resolved based on one type only + // because canonicalization (weak resolution) is forced prior to + // generalizing 'f6', see calls to CanonicalizePartialInferenceProblem in TypeChecker.fs. + let f6 (x: Complex) y = x + y + + // The following does similar to the previous but checks more subtletly about when the resolution + // is done. + let f7 (x: Complex) (y: 'B) (z: 'C) : 'C = + // 1. Commit to first argument Complex + ((+): 'A -> 'B -> 'C) + // Processing the next fragment commits the first type to be Complex + x + // Processing the next fragment checks that we can do dot notation + // name resolution on the type of 'y', which must force 'y' to be nominal. + // + // Just prior to processing this, 'y' still + // has variable type. When processing it, canonicalization (weak resolution) is + // forced on the type of 'y' prior to name resolution, see calls + // to CanonicalizePartialInferenceProblem in TypeChecker.fs TcLookupThen. + (ignore y.Magnitude; y) + + // Next check that overload resolution eagerly commits to Complex * Complex -> Complex overload + let f8 (x: Complex) (y: 'B) (z: 'C) : 'C = + // 1. Commit to first argument Complex + ((+): 'A -> 'B -> 'C) + // Commit first type to be Complex + x + // Check we can do overload resolution based on the type of 'y', + // and this is enough to force 'y' to be nominal. Just prior to processing this, 'y' still + // has variable type, however canonicalization (weak resolution) + // is forced on the type of 'y' prior to overload resolution, see calls + // to CanonicalizePartialInferenceProblem in TypeChecker.fs. + (CheckNominal.CanResolveOverload y; y) + +#if LANGVERSION_PREVIEW + // Next check that overload resolution can commit to Complex * TimeSpan -> Complex overload + // as soon as enough information is available. + // Check resulting type is known to be Complex (by resolving .Magnitude + let f9 (x: Complex) (y: 'B) (z: 'C) : 'C = + // 1. Commit to first argument Complex + ((+): Complex -> 'B -> 'C) + // 2. Commit to second argument TimeSpan + (ignore (y: TimeSpan); x) + // 3. check we already know the type of 'z' + (ignore z.Magnitude; y) +#endif diff --git a/tests/fsharp/core/extconstraint/test-compat.output.bsl b/tests/fsharp/core/extconstraint/test-compat.output.bsl new file mode 100644 index 00000000000..0742c139de4 --- /dev/null +++ b/tests/fsharp/core/extconstraint/test-compat.output.bsl @@ -0,0 +1,67 @@ + +test-compat.fsx(70,13): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'A has been constrained to be type 'Complex'. + +test-compat.fsx(68,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'B has been constrained to be type 'Complex'. + +test-compat.fsx(68,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'C has been constrained to be type 'Complex'. + +test-compat.fsx(85,13): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'A has been constrained to be type 'Complex'. + +test-compat.fsx(83,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'B has been constrained to be type 'Complex'. + +test-compat.fsx(83,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'C has been constrained to be type 'Complex'. + +test-compat.fsx(101,22): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'B has been constrained to be type 'TimeSpan'. + +test-compat.fsx(99,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'C has been constrained to be type 'Complex'. +module TestCompat +module CheckNewOverloadsDoneConfusePreviousCode = begin + type DateTime with + static member + ( + ) : a:System.DateTime * b:System.TimeSpan -> System.DateTime + val x : System.DateTime + val f1 : x:System.DateTime -> System.DateTime + val f2 : x:System.TimeSpan -> y:System.TimeSpan -> System.TimeSpan + val f3 : x:System.DateTime -> y:System.TimeSpan -> System.DateTime + val f4 : x:System.TimeSpan -> y:System.TimeSpan -> System.TimeSpan +end +module CheckNewOverloadsDoneConfusePreviousCode2 = begin + type Complex with + static member + ( + ) : a:System.Numerics.Complex * b:System.TimeSpan -> + System.Numerics.Complex + type CheckNominal = + class + new : unit -> CheckNominal + static member CanResolveOverload : x:System.Numerics.Complex -> unit + static member CanResolveOverload : x:System.TimeSpan -> unit + end + val f1 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f2 : + x:System.Numerics.Complex -> y:System.TimeSpan -> System.Numerics.Complex + val f3 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f4 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f5 : + x:System.Numerics.Complex -> y:System.TimeSpan -> System.Numerics.Complex + val f6 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f7 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> + z:System.Numerics.Complex -> System.Numerics.Complex + val f8 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> + z:System.Numerics.Complex -> System.Numerics.Complex + val f9 : + x:System.Numerics.Complex -> + y:System.TimeSpan -> z:System.Numerics.Complex -> System.Numerics.Complex +end + diff --git a/tests/fsharp/core/extconstraint/test-compat.output.feature-disabled.bsl b/tests/fsharp/core/extconstraint/test-compat.output.feature-disabled.bsl new file mode 100644 index 00000000000..2eefa26a8d4 --- /dev/null +++ b/tests/fsharp/core/extconstraint/test-compat.output.feature-disabled.bsl @@ -0,0 +1,62 @@ + +test-compat.fsx(11,24): warning FS1215: Extension members cannot provide operator overloads. Consider defining the operator as part of the type definition instead. + +test-compat.fsx(26,24): warning FS1215: Extension members cannot provide operator overloads. Consider defining the operator as part of the type definition instead. + +test-compat.fsx(70,13): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'A has been constrained to be type 'Complex'. + +test-compat.fsx(68,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'B has been constrained to be type 'Complex'. + +test-compat.fsx(68,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'C has been constrained to be type 'Complex'. + +test-compat.fsx(85,13): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'A has been constrained to be type 'Complex'. + +test-compat.fsx(83,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'B has been constrained to be type 'Complex'. + +test-compat.fsx(83,11): warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'C has been constrained to be type 'Complex'. +module TestCompat +module CheckNewOverloadsDoneConfusePreviousCode = begin + type DateTime with + static member + ( + ) : a:System.DateTime * b:System.TimeSpan -> System.DateTime + val x : System.DateTime + val f1 : x:System.DateTime -> System.DateTime + val f2 : x:System.TimeSpan -> y:System.TimeSpan -> System.TimeSpan + val f3 : x:System.DateTime -> y:System.TimeSpan -> System.DateTime + val f4 : x:System.TimeSpan -> y:System.TimeSpan -> System.TimeSpan +end +module CheckNewOverloadsDoneConfusePreviousCode2 = begin + type Complex with + static member + ( + ) : a:System.Numerics.Complex * b:System.TimeSpan -> + System.Numerics.Complex + type CheckNominal = + class + new : unit -> CheckNominal + static member CanResolveOverload : x:System.Numerics.Complex -> unit + static member CanResolveOverload : x:System.TimeSpan -> unit + end + val f1 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f2 : + x:System.Numerics.Complex -> y:System.TimeSpan -> System.Numerics.Complex + val f3 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f4 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f6 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> System.Numerics.Complex + val f7 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> + z:System.Numerics.Complex -> System.Numerics.Complex + val f8 : + x:System.Numerics.Complex -> + y:System.Numerics.Complex -> + z:System.Numerics.Complex -> System.Numerics.Complex +end + diff --git a/tests/fsharp/core/extconstraint/test.fsx b/tests/fsharp/core/extconstraint/test.fsx new file mode 100644 index 00000000000..2d43bec389c --- /dev/null +++ b/tests/fsharp/core/extconstraint/test.fsx @@ -0,0 +1,677 @@ +#if TESTS_AS_APP +module Core_extconstraint +#endif + + +let failures = ref [] + +let reportFailure (s : string) = + stderr.Write" NO: " + stderr.WriteLine s + failures := !failures @ [s] + + +let check s e r = + if r = e then stdout.WriteLine (s + ": YES") + else + printf "\n***** %s: FAIL, expected %A, got %A\n" s r e + reportFailure s + +let test s b = + if b then () + else (stderr.WriteLine ("failure: " + s); + reportFailure s) + + +type MyType = + | MyType of int + +/// Extending a .NET primitive type with new operator +module DotNetPrimtiveWithNewOperator = + type System.Int32 with + static member (++)(a: int, b: int) = a + do check "jfs9dlfdhQ" 1 (1 ++ 2) + +/// Extending a .NET primitive type with new instance of an operator +module DotNetPrimtiveExistingOperator1 = + type System.Double with + static member (+)(a: int, b: float) = float a + b + do check "jfs9dlfdhA" 3.0 (2 + 1.0) + +/// Extending a .NET primitive type with new instance of an operator +module DotNetPrimtiveExistingOperator2 = + type System.Double with + static member (+)(a: float, b: int) = a + float b + do check "jfs9dlfdh0" 3.0 (1.0 + 2) + do check "jfs9dlfdh1" 3.0 (1.0 + 2.0) + +/// Extending a .NET primitive type with new instance of an operator +module DotNetPrimtiveExistingOperator3 = + type System.Double with + static member (+)(a: float, b: int) = a + float b + static member (+)(a: int, b: float) = float a + b + do check "jfs9dlfdh2" 3 (2 + 1) + do check "jfs9dlfdh3" 3.0 (2 + 1.0) + do check "jfs9dlfdh4" 3.0 (1.0 + 2) + do check "jfs9dlfdh5" 3.0 (1.0 + 2.0) + +/// Extension members take precedence in most-recently-opened order +module ExtensionPrecedence1 = + [] + module M1 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + + [] + module M2 = + type System.Double with + static member (+)(a: int, b: float) = float a + b + 4.0 + do check "jfs9dlfdh6" 7.0 (2 + 1.0) // note we call the second one + +/// Extension members take precedence in most-recently-opened order +/// +/// Like the previous test but we change the declarations a little +module ExtensionPrecedence2 = + [] + module M1 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + + [] + module M2 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + 4.0 + + do check "jfs9dlfdh6" 7.0 (2 + 1.0) // note we call the second one + +/// Extension members take precedence in most-recently-opened order +/// +/// Like the previous test but we change the declarations a little +module ExtensionPrecedence3 = + module Extensions1 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + + module Extensions2 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + 4.0 + open Extensions1 + open Extensions2 + do check "jfs9dlfdh7" 7.0 (2 + 1.0) // note we call the second one + +/// Extension members take precedence in most-recently-opened order +/// +/// Like the previous test but we change the declarations a little +module ExtensionPrecedence4 = + module Extensions2 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + 4.0 + + module Extensions1 = + type System.Int32 with + static member (+)(a: int, b: float) = float a + b + + open Extensions1 + open Extensions2 + do check "jfs9dlfdh8" 7.0 (2 + 1.0) // note we call the Extensions2 one + +/// Extending a .NET primitive type with new operator +module DotNetPrimtiveWithAmbiguousNewOperator = + [] + module Extensions = + type System.Int32 with + static member (++)(a: int, b: int) = a + + do check "jfs9dlfdhsx" 1 (1 ++ 2) + + [] + module Extensions2 = + type System.Int32 with + static member (++)(a: int, b: string) = a + + do check "jfs9dlfdhsx1" 1 (1 ++ "2") + + let f (x: string) = 1 ++ x + + do check "jfs9dlfdhsx2" 1 (f "2") + +/// Extending a .NET primitive type with new _internal_ operator +module DotNetPrimtiveWithInternalOperator1 = + type System.Int32 with + static member internal (++)(a: int, b: int) = a + + let result = 1 ++ 2 // this is now allowed + check "vgfmjsdokfj" result 1 + + +/// Extending a .NET primitive type with new _private_ operator where that operator is accessible at point-of-use +module DotNetPrimtiveWithAccessibleOperator2 = + type System.Int32 with + static member private (++)(a: int, b: int) = a + + let result = 1 ++ 2 // this is now allowed. + check "vgfmjsdokfjc" result 1 + + + +#if NEGATIVE_TESTS +module DotNetPrimtiveWithInaccessibleOperator = + [] + module Extensions = + type System.Int32 with + static member private (++)(a: int, b: int) = a + + let result = 1 ++ 2 // This should fail to compile because the private member is not accessible from here +#endif + + +/// Locally extending an F# type with a wide range of standard operators +module FSharpTypeWithExtrinsicOperators = + + [] + module Extensions = + type MyType with + static member (+)(MyType x, MyType y) = MyType (x + y) + static member (*)(MyType x, MyType y) = MyType (x * y) + static member (/)(MyType x, MyType y) = MyType (x / y) + static member (-)(MyType x, MyType y) = MyType (x - y) + static member (~-)(MyType x) = MyType (-x) + static member (|||)(MyType x, MyType y) = MyType (x ||| y) + static member (&&&)(MyType x, MyType y) = MyType (x &&& y) + static member (^^^)(MyType x, MyType y) = MyType (x ^^^ y) + static member Zero = MyType 0 + static member One = MyType 1 + member this.Sign = let (MyType x) = this in sign x + static member Abs (MyType x) = MyType (abs x) + static member Sqrt (MyType x) = MyType (int (sqrt (float x))) + static member Sin (MyType x) = MyType (int (sin (float x))) + static member Cos (MyType x) = MyType (int (cos (float x))) + static member Tan (MyType x) = MyType (int (tan (float x))) + static member DivideByInt (MyType x, n: int) = MyType (x / n) + + let v = MyType 3 + let result1 = v + v + do check "fsdnjioa1" (MyType 6) result1 + let result2 = v * v + do check "fsdnjioa2" (MyType 9) result2 + let result3 = v - v + do check "fsdnjioa3" (MyType 0) result3 + let result4 = v / v + do check "fsdnjioa4" (MyType 1) result4 + let result5 = -v + do check "fsdnjioa5" (MyType -3) result5 + let result6 = v ||| v + do check "fsdnjioa6" (MyType 3) result6 + let result7 = v &&& v + do check "fsdnjioa7" (MyType 3) result7 + let result8 = v ^^^ v + do check "fsdnjioa8" (MyType 0) result8 + let result9 = LanguagePrimitives.GenericZero + do check "fsdnjioa9" (MyType 0) result9 + let result10 = LanguagePrimitives.GenericOne + do check "fsdnjioa10" (MyType 1) result10 + let result11 = sign v + do check "fsdnjioa11" 1 result11 + let result12 = abs v + do check "fsdnjioa12" (MyType 3) result12 + let result13 = sqrt v + do check "fsdnjioa13" (MyType 1) result13 + let result14 = sin v + do check "fsdnjioa14" (MyType 0) result14 + let result15 = cos v + do check "fsdnjioa15" (MyType 0) result15 + let result16 = tan v + do check "fsdnjioa16" (MyType 0) result16 + let result17 = LanguagePrimitives.DivideByInt v 4 + do check "fsdnjioa17" (MyType 0) result17 + + +/// Extending two types with the static member 'Add' +module TwoTypesWithExtensionOfSameName = + + [] + module Extensions = + type System.Int32 with + static member Add(a: int, b: int) = a + + type MyType with + static member Add(MyType x, MyType y) = MyType (x + y) + + let inline addGeneric< ^A when ^A : (static member Add : ^A * ^A -> ^A) > (a,b) : ^A = + (^A : (static member Add : ^A * ^A -> ^A) (a,b)) + + let inline (+++) a b = addGeneric(a,b) + + let inline addGeneric2 (a,b) : ^A when ^A : (static member Add : ^A * ^A -> ^A) = + (^A : (static member Add : ^A * ^A -> ^A) (a,b)) + + let inline (++++) a b = addGeneric2(a,b) + + + let f () = + let v1 = addGeneric (MyType(1), MyType(2)) + let v2 = addGeneric (1,1) + () + + let f2 () = + let v1 = MyType(1) +++ MyType(2) + let v2 = 1 +++ 1 + 1 + + let f3 () = + let v1 = addGeneric2 (MyType(1), MyType(2)) + let v2 = addGeneric2 (1,1) + () + + let f4 () = + let v1 = MyType(1) ++++ MyType(2) + let v2 = 1 ++++ 1 + () + + /// The check is that the above code compiles OK + +/// Extending a generic type with a property +module ExtendingGenericTypeWithProperty = + + type List<'T> with + member x.Count = x.Length + + let inline count (a : ^A when ^A : (member Count : int)) = + (^A : (member Count : int) (a)) + + let v0 = [3].Count // sanity check + do check "opcjdkfdf" 1 v0 + + let v3 = count [3] + do check "opcjdkfdfx" 1 v3 + + let v5 = count (ResizeArray [| 3 |]) + do check "opcjdkfdfxa" 1 v5 + +/// Extending a generic type with a property +/// Extending the .NET array type with a property +module ExtendingGenericTypeAndArrayWithProperty = + + type List<'T> with + member x.Count = x.Length + + type ``[]``<'T> with + member x.Count = x.Length + + let inline count (a : ^A when ^A : (member Count : int)) = + (^A : (member Count : int) (a)) + + let v0 = [3].Count // sanity check + do check "fdoiodjjs" 1 v0 + + let v1 = [|3|].Count // sanity check + do check "fdoiodxjxjs" 1 v1 + + let v3 = count [3] + do check "fdoios" 1 v3 + + let v4 = count [| 3 |] + do check "fddxjxjs" 1 v4 + + let v5 = count (dict [| 1,3 |]) + do check "fdoiosdxs" 1 v5 + + let v6 = count (ResizeArray [| 3 |]) // intrinsic from .NET + do check "fdojxxjs" 1 v6 + + + + +/// Solving using LINQ extensions +module LinqExtensionMethodsProvideSolutions_Count = + + open System.Linq + + // Note this looks for a _method_ called `Count` taking a single argument + // It is _not_ considered the same as a property called `Count` + let inline countm (a : ^A when ^A : (member Count : unit -> int)) = + (^A : (member Count : unit -> int) (a)) + + let seqv : seq = Seq.singleton 1 + + let v0 = seqv.Count() // sanity check + do check "fivjijvd" 1 v0 + + let v1 = countm seqv + do check "fivjixjvd" 1 v1 + + + +/// Solving using F#-defined extensions +module CSharpStyleExtensionMethodsProvideSolutions_Count2 = + + // Note this looks for a _method_ called `Count` taking a single argument + // It is _not_ considered the same as a property called `Count` + let inline countm (a : ^A when ^A : (member Count : unit -> int)) = + (^A : (member Count : unit -> int) (a)) + + type TwoIntegers(a:int, b:int) = + member x.A = a + member x.B = b + + [] + type Extension() = + [] + static member Count(c: TwoIntegers) = 2 + + let two = TwoIntegers(2,3) + let v0 = two.Count() // sanity check + do check "fivjijvd33" 2 v0 + + let v1 = countm two + do check "fivjixjvd33" 2 v1 + +/// Solving using F#-defined extensions +module CSharpStyleExtensionMethodsProvideSolutions_Count3 = + open System.Runtime.CompilerServices + [] + type Ext2() = + [] + static member Bleh(a : string) = a.Length + + let inline bleh s = (^a : (member Bleh : unit -> int) s) + + let v = bleh "a" + do check "cojkicjkc" 1 v + +/// Solving using F#-defined extensions (generic) +module CSharpStyleExtensionMethodsProvideSolutions_Count4 = + + // Note this looks for a _method_ called `Count` taking a single argument + // It is _not_ considered the same as a property called `Count` + let inline countm (a : ^A when ^A : (member Count : unit -> int)) = + (^A : (member Count : unit -> int) (a)) + + type Two<'T1, 'T2>(a: 'T1, b: 'T2) = + member x.A = a + member x.B = b + + [] + type Extension() = + [] + static member Count(c: Two<'T1, 'T2>) = 2 + + let two = Two(2,3) + let v0 = two.Count() // sanity check + do check "fivjijvd33" 2 v0 + + let v1 = countm two + do check "fivjixjvd33" 2 v1 + +module ExtendingGenericType1 = + open System + type ``[]``<'T> with + // The generic type parameter must not be the same as the enclosing, which is unconstrained + static member inline (+)(a:'T1[], b: 'T2[]) = Array.map2 (+) a b + + let v1 = [|1;2;3|] + [|2;3;4|] //Okay + do check "kldjfdo1" [|3;5;7|] v1 + let v2 = [|TimeSpan(52342L)|] + [|TimeSpan(3213L)|] //Okay + do check "kldjfdo2" ([|TimeSpan(52342L + 3213L)|]) v2 + let v3 = [|1m|] + [|2m|] //Okay + do check "kldjfdo3" ([|3m|]) v3 + let v4 = [|1uy|] + [|2uy|] //Okay + do check "kldjfdo4" ([|3uy|]) v4 + let v5 = [|1L|] + [|2L|] //Okay + do check "kldjfdo5" ([|3L|]) v5 + let v6 = [|1I|] + [|2I|] //Okay + do check "kldjfdo6" ([|3I|]) v6 + let v7 = [| [|1 ; 1|]; [|2|] |] + [| [|2; 2|]; [|3|] |] //Okay + do check "kldjfdo7" [| [|3 ; 3|]; [|5|] |] v7 + let v8 = [| [| [| [|2|] |] |] |] + [| [| [| [|5|] |] |] |] //Okay + do check "kldjfdo8" [| [| [| [|7|] |] |] |] v8 + //Compile Errors: + //let v9 = [|"1"|] + [|"2"|] //error FS0001 + //let v10 = [|1.f|] + [|2.f|] //error FS0001 + //let v11 = [|1.0|] + [|2.0|] //error FS0001 + +(*--------------------------------------------------------------------------- +!* wrap up + *--------------------------------------------------------------------------- *) + +module SystematicTests = + + // 1-arg extensions to each primitive type + // 2-arg extensions to each primitive type + // 2-arg extensions to each primitive type + new sealed type + // 2-arg extensions to each primitive type + new unsealed type + // 2-arg extensions to new sealed type + each primitive type + // 2-arg extensions to new unsealed type + each primitive type + // 2-arg extensions to new sealed type + new unsealed type + let inline CallStaticMethod1 (x: ^T) = ((^T): (static member StaticMethod1: ^T -> ^T) (x)) + let inline CallStaticMethod2 (x: ^T, y: ^T) = ((^T): (static member StaticMethod2: ^T * ^T -> ^T) (x, y)) + let inline CallStaticMethod3 (x: ^T, y: ^U) = ((^T or ^U): (static member StaticMethod3: ^T * ^U -> ^V) (x, y)) + let inline CallOverloadedStaticMethod4 (x: ^T, y: ^U) = ((^T or ^U): (static member OverloadedStaticMethod4: ^T * ^U -> ^V) (x, y)) + let inline CallInstanceMethod1 (x: ^T, y: ^T) = ((^T): (member InstanceMethod1: ^T -> ^T) (x, y)) + let inline CallInstanceProperty1 (x: ^T) = ((^T): (member InstanceProperty1: ^T) (x)) + let inline CallStaticProperty1 () = ((^T): (static member StaticProperty1: ^T) ()) + + module MethodsOnStructType = + + [] + type R = + { F : int } + + static member op_UnaryNegation (x: R) = { F = x.F + 4 } + static member StaticMethod1 (x: R) = { F = x.F + 4 } + static member StaticMethod2 (x: R, y: R) = { F = x.F + y.F + 4 } + static member op_Addition (x: R, y: R) = { F = x.F + y.F + 4 } + static member op_Subtraction (x: R, y: R) = { F = x.F + y.F + 5 } + static member op_Division (x: R, y: R) = { F = x.F + y.F + 6 } + static member StaticMethod3 (x: R, y: R) = { F = x.F + y.F + 4 } + static member OverloadedStaticMethod4 (x: R, y: string) = { F = x.F + y.Length + 4 } + static member OverloadedStaticMethod4 (x: R, y: int) = { F = x.F + y + 4 } + member x.InstanceMethod1 (y: R) = { F = x.F + y.F + 5 } + static member StaticProperty1 = { F = 4 } + member x.InstanceProperty1 = { F = x.F + 4 } + + let r3 = { F = 3 } + let r4 = { F = 4 } + check "qvwoiwvoi0" (-r3).F 7 + check "qvwoiwvoi1" (CallStaticMethod1 r3).F 7 + check "qvwoiwvoi2" (CallStaticMethod2 (r3, r4)).F 11 + check "qvwoiwvoi2b" ((+) r3 r4).F 11 + check "qvwoiwvoi2c" ((-) r3 r4).F 12 + check "qvwoiwvoi2c" ((/) r3 r4).F 13 + check "qvwoiwvoi3" (CallStaticMethod3 (r3, r4)).F 11 + check "qvwoiwvoi4" (CallOverloadedStaticMethod4 (r3, 4)).F 11 + check "qvwoiwvoi5" (CallOverloadedStaticMethod4 (r3, "four")).F 11 + check "qvwoiwvoi6" (CallInstanceMethod1 (r3, r4)).F 12 + check "qvwoiwvoi7" (CallInstanceProperty1 (r3)).F 7 + check "qvwoiwvoi8" (CallStaticProperty1().F : int32) 4 + + module ExtensionsOnStructType = + + [] + type R = + { F : int } + + [] + module Extensions = + type R with + static member op_UnaryNegation (x: R) = { F = x.F + 4 } + static member StaticMethod1 (x: R) = { F = x.F + 4 } + static member StaticMethod2 (x: R, y: R) = { F = x.F + y.F + 4 } + static member op_Addition (x: R, y: R) = { F = x.F + y.F + 4 } + static member op_Subtraction (x: R, y: R) = { F = x.F + y.F + 5 } + static member op_Division (x: R, y: R) = { F = x.F + y.F + 6 } + static member StaticMethod3 (x: R, y: R) = { F = x.F + y.F + 4 } + static member OverloadedStaticMethod4 (x: R, y: string) = { F = x.F + y.Length + 4 } + static member OverloadedStaticMethod4 (x: R, y: int) = { F = x.F + y + 4 } + member x.InstanceMethod1 (y: R) = { F = x.F + y.F + 5 } + static member StaticProperty1 = { F = 4 } + member x.InstanceProperty1 = { F = x.F + 4 } + + let r3 = { F = 3 } + let r4 = { F = 4 } + check "aqvwoiwvoi0" (-r3).F 7 + check "aqvwoiwvoi1" (CallStaticMethod1 r3).F 7 + check "aqvwoiwvoi2" (CallStaticMethod2 (r3, r4)).F 11 + check "aqvwoiwvoi2b" ((+) r3 r4).F 11 + check "aqvwoiwvoi2c" ((-) r3 r4).F 12 + check "aqvwoiwvoi2c" ((/) r3 r4).F 13 + check "aqvwoiwvoi3" (CallStaticMethod3 (r3, r4)).F 11 + check "aqvwoiwvoi4" (CallOverloadedStaticMethod4 (r3, 4)).F 11 + check "aqvwoiwvoi5" (CallOverloadedStaticMethod4 (r3, "four")).F 11 + check "aqvwoiwvoi6" (CallInstanceMethod1 (r3, r4)).F 12 + check "aqvwoiwvoi7" (CallInstanceProperty1 (r3)).F 7 + check "aqvwoiwvoi8" (CallStaticProperty1().F : int32) 4 + + + module MixedOverloadedOperatorMethodsOnStructType = + + [] + type R = + { F : int } + + static member (+) (x: R, y: R) = { F = x.F + y.F + 4 } + static member (+) (x: R, y: string) = { F = x.F + y.Length + 6 } + static member (+) (x: R, y: int) = { F = x.F + y + 6 } + static member (+) (x: string, y: R) = { F = x.Length + y.F + 9 } + static member (+) (x: int, y: R) = { F = x + y.F + 102 } + + let r3 = { F = 3 } + let r4 = { F = 4 } + check "qvwoiwvoi2b" ((+) r3 r4).F 11 + check "qvwoiwvoi2b" ((+) r3 "four").F 13 + check "qvwoiwvoi2b" ((+) "four" r3).F 16 + check "qvwoiwvoi2b" ((+) r3 4).F 13 + check "qvwoiwvoi2b" ((+) 4 r3).F 109 + // TODO - more operators here + + module MixedOverloadedOperatorExtensionsOnStructType = + + [] + type R = + { F : int } + + [] + module Extensions = + type R with + static member (+) (x: R, y: R) = { F = x.F + y.F + 4 } + static member (+) (x: R, y: string) = { F = x.F + y.Length + 6 } + static member (+) (x: R, y: int) = { F = x.F + y + 6 } + static member (+) (x: string, y: R) = { F = x.Length + y.F + 9 } + static member (+) (x: int, y: R) = { F = x + y.F + 102 } + + let r3 = { F = 3 } + let r4 = { F = 4 } + check "qvwoiwvoi2b" ((+) r3 r4).F 11 + check "qvwoiwvoi2b" ((+) r3 "four").F 13 + check "qvwoiwvoi2b" ((+) "four" r3).F 16 + check "qvwoiwvoi2b" ((+) r3 4).F 13 + check "qvwoiwvoi2b" ((+) 4 r3).F 109 + //check "qvwoiwvoi2c" ((-) r3 r4).F 12 + //check "qvwoiwvoi2c" ((/) r3 r4).F 13 + // TODO - more operators here + + + module ExtensionsToPrimitiveType_Int32 = + + [] + module Extensions = + type System.Int32 with + static member StaticMethod1 (x: int32) = x + 4 + static member StaticMethod2 (x: int32, y: int32) = x + y + 4 + static member StaticMethod3 (x: int32, y: int32) = x + y + 4 + static member OverloadedStaticMethod4 (x: int32, y: string) = x + y.Length + 4 + static member OverloadedStaticMethod4 (x: int32, y: int) = x + y + 4 + member x.InstanceMethod1 (y: int32) = x + y + 5 + static member StaticProperty1 = 4 + member x.InstanceProperty1 = x + 4 + + check "2vwoiwvoi1" (CallStaticMethod1 3) 7 + check "2vwoiwvoi2" (CallStaticMethod2 (3, 4)) 11 + check "2vwoiwvoi3" (CallStaticMethod3 (3, 4)) 11 + check "2vwoiwvoi4" (CallOverloadedStaticMethod4 (3, 4)) 11 + check "2vwoiwvoi5" (CallOverloadedStaticMethod4 (3, "four")) 11 + check "2vwoiwvoi6" (CallInstanceMethod1 (3, 4)) 12 + check "2vwoiwvoi7" (CallInstanceProperty1 (3)) 7 + check "2vwoiwvoi8" (CallStaticProperty1 () : int32) 4 + + +module Test1 = + + open System + type Foo = A | B + + module Extensions = + type Foo with + static member (+) (foo1: Foo, foo2: Foo) = B + + open Extensions + + let result = A + A + + type System.String with + member this.Foo (x: string) = this + x + +module Test2 = + + open System + type Foo = A | B + + module Extensions = + type Foo with + static member (+) (foo1: Foo, foo2: Foo) = B + + type Foo with + static member (+) (foo1: Foo, foo2: string) = B + static member (+) (foo1: string, foo2: Foo) = B + + open Extensions + + let result = A + A + let result2 = A + "" + let result3 = "" + A + let result4 : string = "" + "" + + type System.String with + member this.Foo (x: string) = this + x + + type System.String with + member this.Foo2 x = this + x + + type Bar = Bar of String + with + member this.Foo (x: string) = + match this with + | Bar y -> y + x + + let z = "Bar".Foo("foo") + let z0 = (Bar "Bar").Foo("foo") + +module PositiveTestOfFSharpPlusDesignPattern1 = + let inline InvokeMap (mapping: ^F) (source: ^I) : ^R = + (^I : (static member Map : ^I * ^F -> ^R) source, mapping) + + // A simulated collection with a'Map' witness + type Coll<'T>(x: 'T) = + member _.X = x + static member Map (source: Coll<'a>, mapping: 'a->'b) : Coll<'b> = new Coll<'b>(mapping source.X) + + let inline AddTwice (x: Coll<'a>) (v: 'a) : Coll<'a> = + InvokeMap ((+) v) (InvokeMap ((+) v) x) + + check "vrejklervjlr1" (AddTwice (Coll(3)) 2).X 7 + check "vrejklervjlr2" (AddTwice (Coll(3y)) 2y).X 7y + +#if TESTS_AS_APP +let RUN() = !failures +#else +let aa = + match !failures with + | [] -> + stdout.WriteLine "Test Passed" + System.IO.File.WriteAllText("test.ok","ok") + exit 0 + | _ -> + stdout.WriteLine "Test Failed" + exit 1 +#endif + diff --git a/tests/fsharp/core/members/basics-hw-mutrec/test.fs b/tests/fsharp/core/members/basics-hw-mutrec/test.fs index 7a1fb2a049a..7b3e1256a76 100644 --- a/tests/fsharp/core/members/basics-hw-mutrec/test.fs +++ b/tests/fsharp/core/members/basics-hw-mutrec/test.fs @@ -1606,9 +1606,9 @@ module MultipleOverloadedOperatorTests = begin let f1 (x:DateTime) (y:TimeSpan) : DateTime = x - y let g1 (x:DateTime) (y:DateTime) : TimeSpan = x - y - // Return type is also sufficient: - let f2 (x:DateTime) y : DateTime = x - y - let g2 (x:DateTime) y : TimeSpan = x - y + // // Return type is not sufficient: + // let f2 (x:DateTime) y : DateTime = x - y + // let g2 (x:DateTime) y : TimeSpan = x - y // Just argument types are also sufficient: let f3 (x:DateTime) (y:TimeSpan) = x - y let g3 (x:DateTime) (y:DateTime) = x - y diff --git a/tests/fsharp/core/members/basics-hw/test.fsx b/tests/fsharp/core/members/basics-hw/test.fsx index 06e09388906..189b5747542 100644 --- a/tests/fsharp/core/members/basics-hw/test.fsx +++ b/tests/fsharp/core/members/basics-hw/test.fsx @@ -1621,9 +1621,9 @@ module MultipleOverloadedOperatorTests = begin let f1 (x:DateTime) (y:TimeSpan) : DateTime = x - y let g1 (x:DateTime) (y:DateTime) : TimeSpan = x - y - // Return type is also sufficient: - let f2 (x:DateTime) y : DateTime = x - y - let g2 (x:DateTime) y : TimeSpan = x - y + // // Return type is not sufficient: + // let f2 (x:DateTime) y : DateTime = x - y + // let g2 (x:DateTime) y : TimeSpan = x - y // Just argument types are also sufficient: let f3 (x:DateTime) (y:TimeSpan) = x - y let g3 (x:DateTime) (y:DateTime) = x - y diff --git a/tests/fsharp/core/members/basics/test.fs b/tests/fsharp/core/members/basics/test.fs index 79fd5eb33eb..a29e1d9c27a 100644 --- a/tests/fsharp/core/members/basics/test.fs +++ b/tests/fsharp/core/members/basics/test.fs @@ -1910,9 +1910,9 @@ module MultipleOverloadedOperatorTests = begin let f1 (x:DateTime) (y:TimeSpan) : DateTime = x - y let g1 (x:DateTime) (y:DateTime) : TimeSpan = x - y - // Return type is also sufficient: - let f2 (x:DateTime) y : DateTime = x - y - let g2 (x:DateTime) y : TimeSpan = x - y + // Return type is not sufficient: + //let f2 (x:DateTime) y : DateTime = x - y + //let g2 (x:DateTime) y : TimeSpan = x - y // Just argument types are also sufficient: let f3 (x:DateTime) (y:TimeSpan) = x - y let g3 (x:DateTime) (y:DateTime) = x - y diff --git a/tests/fsharp/core/members/ops-mutrec/test.fs b/tests/fsharp/core/members/ops-mutrec/test.fs index 8b816fa7def..211f3940a51 100644 --- a/tests/fsharp/core/members/ops-mutrec/test.fs +++ b/tests/fsharp/core/members/ops-mutrec/test.fs @@ -214,8 +214,8 @@ module BasicOverloadTests = // This gets type int -> int let f5 x = 1 - x - // This gets type DateTime -> DateTime -> TimeSpan, through non-conservative resolution. - let f6 x1 (x2:System.DateTime) = x1 - x2 + // // This gets type DateTime -> DateTime -> TimeSpan, through non-conservative resolution. + // let f6 x1 (x2:System.DateTime) = x1 - x2 // This gets type TimeSpan -> TimeSpan -> TimeSpan, through default type propagation let f7 x1 (x2:System.TimeSpan) = x1 - x2 diff --git a/tests/fsharp/core/subtype/test.fsx b/tests/fsharp/core/subtype/test.fsx index 76de2b2d520..ed1977961eb 100644 --- a/tests/fsharp/core/subtype/test.fsx +++ b/tests/fsharp/core/subtype/test.fsx @@ -1764,50 +1764,6 @@ module GenericPropertyConstraintSolvedByRecord = let v = print_foo_memb { foo=1 } -/// In this case, the presence of the Method(obj) overload meant overload resolution was being applied and resolving to that -/// overload, even before the full signature of the trait constraint was known. -module MethodOverloadingForTraitConstraintsIsNotDeterminedUntilSignatureIsKnnown = - type X = - static member Method (a: obj) = 1 - static member Method (a: int) = 2 - static member Method (a: int64) = 3 - - - let inline Test< ^t, ^a when ^t: (static member Method: ^a -> int)> (value: ^a) = - ( ^t: (static member Method: ^a -> int)(value)) - - let inline Test2< ^t> a = Test a - - // NOTE, this is seen to be a bug, see https://github.com/Microsoft/visualfsharp/issues/3814 - // The result should be 2. - // This test has been added to pin down current behaviour pending a future bug fix. - check "slvde0vver90u1" (Test2 0) 1 - check "slvde0vver90u2" (Test2 0L) 1 - -/// In this case, the presence of the "Equals" method on System.Object was causing method overloading to be resolved too -/// early, when ^t was not yet known. The underlying problem was that we were proceeding with weak resolution -/// even for a single-support-type trait constraint. -module MethodOverloadingForTraitConstraintsWhereSomeMethodsComeFromObjectTypeIsNotDeterminedTooEarly = - type Test() = - member __.Equals (_: Test) = true - - //let inline Equals(a: obj) (b: ^t) = - // match a with - // | :? ^t as x -> (^t: (member Equals: ^t -> bool) (b, x)) - // | _-> false - - let a = Test() - let b = Test() - - // NOTE, this is seen to be a bug, see https://github.com/Microsoft/visualfsharp/issues/3814 - // - // The result should be true. - // - // This test should be added to pin down current behaviour pending a future bug fix. - // - // However the code generated fails peverify.exe so even the pin-down test has been removed for now. - //check "cewjewcwec09ew" (Equals a b) false - module SRTPFix = open System @@ -2537,6 +2493,20 @@ module TestConverter = test "cenwceoiwe2" ((id |> toConverter |> fromConverter |> toConverter2 |> implicitConv) 6 = 6) #endif +// See https://github.com/dotnet/fsharp/issues/3814#issuecomment-441048460 +module TestAnotherCaseOfSRTP = + + type X = + static member Method (a: int) = 2 + static member Method (a: int64) = 3 + + + let inline Test< ^t, ^a when (^t or ^a): (static member Method: ^a -> int)> (value: ^a) = + ( (^t or ^a): (static member Method: ^a -> int)(value)) + + let inline Test2< ^t when (X or ^t) : (static member Method : ^t -> int)> a = Test a + + check "fweew-0wve" (Test2 0) 2 #if TESTS_AS_APP let RUN() = !failures diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index 3e1ab4390bc..3bc9a98a073 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -396,11 +396,19 @@ let singleVersionedNegTest (cfg: TestConfig) version testname = fsi_flags = sprintf "%s --preferreduilang:en-US %s" cfg.fsi_flags options } + let ERRFILE, BSLFILE = + let vbsl = sprintf "%s.%s.bsl" testname version + if fileExists cfg vbsl then + sprintf "%s.%s.err" testname version, vbsl + else + sprintf "%s.err" testname, sprintf "%s.bsl" testname + // REM == Set baseline (fsc vs vs, in case the vs baseline exists) - let VSBSLFILE = - if (sprintf "%s.vsbsl" testname) |> (fileExists cfg) - then sprintf "%s.vsbsl" testname - else sprintf "%s.bsl" testname + let VSERRFILE, VSBSLFILE = + if fileExists cfg (sprintf "%s.vsbsl" testname) then + sprintf "%s.vserr" testname, sprintf "%s.vsbsl" testname + else + ERRFILE, BSLFILE let sources = [ let src = [ testname + ".mli"; testname + ".fsi"; testname + ".ml"; testname + ".fs"; testname + ".fsx"; @@ -417,10 +425,8 @@ let singleVersionedNegTest (cfg: TestConfig) version testname = ] - if fileExists cfg (testname + "-pre.fs") - then - fsc cfg "%s -a -o:%s-pre.dll" cfg.fsc_flags testname [testname + "-pre.fs"] - else () + if fileExists cfg (testname + "-pre.fs") then + fsc cfg "%s -a -o:%s-pre.dll" cfg.fsc_flags testname [testname + "-pre.fs"] if fileExists cfg (testname + "-pre.fsx") then fsi_script cfg "--exec %s %s %s" @@ -435,29 +441,29 @@ let singleVersionedNegTest (cfg: TestConfig) version testname = if cfg.fsc_flags.Contains("--warnaserror-") then String.Empty else "--warnaserror" - fscAppendErrExpectFail cfg (sprintf "%s.err" testname) """%s --vserrors %s --nologo --maxerrors:10000 -a -o:%s.dll""" cfg.fsc_flags warnaserror testname sources + fscAppendErrExpectFail cfg ERRFILE """%s --vserrors %s --nologo --maxerrors:10000 -a -o:%s.dll""" cfg.fsc_flags warnaserror testname sources - let diff = fsdiff cfg (sprintf "%s.err" testname) (sprintf "%s.bsl" testname) + let diff = fsdiff cfg ERRFILE BSLFILE - fscAppendErrExpectFail cfg (sprintf "%s.vserr" testname) "%s --test:ContinueAfterParseFailure --vserrors %s --nologo --maxerrors:10000 -a -o:%s.dll" cfg.fsc_flags warnaserror testname sources + fscAppendErrExpectFail cfg VSERRFILE "%s --test:ContinueAfterParseFailure --vserrors %s --nologo --maxerrors:10000 -a -o:%s.dll" cfg.fsc_flags warnaserror testname sources - let vbslDiff = fsdiff cfg (sprintf "%s.vserr" testname) VSBSLFILE + let vbslDiff = fsdiff cfg VSERRFILE VSBSLFILE match diff,vbslDiff with - | "","" -> - log "Good, output %s.err matched %s.bsl" testname testname - log "Good, output %s.vserr matched %s" testname VSBSLFILE - | l,"" -> - log "***** %s.err %s.bsl differed: a bug or baseline may need updating" testname testname - failwithf "%s.err %s.bsl differ; %A" testname testname l + | "","" -> + log "Good, output %s matched %s" ERRFILE BSLFILE + log "Good, output %s matched %s" VSERRFILE VSBSLFILE + | l,"" -> + log "***** %s %s differed: a bug or baseline may need updating" ERRFILE BSLFILE + failwithf "%s %s differ; %A" ERRFILE BSLFILE l | "",l -> - log "Good, output %s.err matched %s.bsl" testname testname - log "***** %s.vserr %s differed: a bug or baseline may need updating" testname VSBSLFILE - failwithf "%s.vserr %s differ; %A" testname VSBSLFILE l - | l1,l2 -> - log "***** %s.err %s.bsl differed: a bug or baseline may need updating" testname testname - log "***** %s.vserr %s differed: a bug or baseline may need updating" testname VSBSLFILE - failwithf "%s.err %s.bsl differ; %A; %s.vserr %s differ; %A" testname testname l1 testname VSBSLFILE l2 + log "Good, output %s matched %s" ERRFILE BSLFILE + log "***** %s %s differed: a bug or baseline may need updating" VSERRFILE VSBSLFILE + failwithf "%s %s differ; %A" VSERRFILE VSBSLFILE l + | l1,l2 -> + log "***** %s %s differed: a bug or baseline may need updating" ERRFILE BSLFILE + log "***** %s %s differed: a bug or baseline may need updating" VSERRFILE VSBSLFILE + failwithf "%s %s differ; %A; %s %s differ; %A" ERRFILE BSLFILE l1 VSERRFILE VSBSLFILE l2 let singleNegTest (cfg: TestConfig) testname = diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index e1ec4ad346d..040385583f3 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -746,6 +746,85 @@ module CoreTests = exec cfg ("." ++ "testcs.exe") "" + [] + let ``extconstraint-fsc preview`` () = + let cfg = testConfig "core/extconstraint" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --langversion:preview" } + + csc cfg """/nologo /target:library /out:cslib.dll""" ["cslib.cs"] + + fsc cfg "%s -o:test.exe -r cslib.dll -g --optimize+" cfg.fsc_flags ["test.fsx"] + + peverify cfg "test.exe" + + use testOkFile = fileguard cfg "test.ok" + + exec cfg ("." ++ "test.exe") "" + + testOkFile.CheckExists() + + [] + let ``extconstraint-fsc-no-optimize preview`` () = + let cfg = testConfig "core/extconstraint" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --langversion:preview" } + + csc cfg """/nologo /target:library /out:cslib.dll""" ["cslib.cs"] + + fsc cfg "%s -o:test-debug.exe -r cslib.dll -g --optimize-" cfg.fsc_flags ["test.fsx"] + + peverify cfg "test-debug.exe" + + use testOkFile = fileguard cfg "test.ok" + + exec cfg ("." ++ "test-debug.exe") "" + + testOkFile.CheckExists() + + [] + let ``extconstraint-fsi preview`` () = + let cfg = testConfig "core/extconstraint" + let cfg = { cfg with fsi_flags = cfg.fsi_flags + " --langversion:preview" } + + use testOkFile = fileguard cfg "test.ok" + + fsi cfg "%s" cfg.fsi_flags ["test.fsx"] + + testOkFile.CheckExists() + + [] + let ``extconstraint-compat preview`` () = + let cfg = testConfig "core/extconstraint" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --define:LANGVERSION_PREVIEW --langversion:preview" } + + let outFile = "test-compat.output.txt" + let expectedFile = "test-compat.output.bsl" + + fscBothToOut cfg outFile "%s -i --nologo" cfg.fsc_flags ["test-compat.fsx"] + + let diff = fsdiff cfg outFile expectedFile + + match diff with + | "" -> () + | _ -> + Assert.Fail (sprintf "'%s' and '%s' differ; %A" (getfullpath cfg outFile) (getfullpath cfg expectedFile) diff) + + [] + let ``extconstraint-compat2`` () = + let cfg = testConfig "core/extconstraint" + let cfg = { cfg with fsc_flags = cfg.fsc_flags + " --langversion:4.6" } + + let outFile = "test-compat.output.feature-disabled.txt" + let expectedFile = "test-compat.output.feature-disabled.bsl" + + fscBothToOut cfg outFile "%s -i --nologo" cfg.fsc_flags ["test-compat.fsx"] + + let diff = fsdiff cfg outFile expectedFile + + match diff with + | "" -> () + | _ -> + Assert.Fail (sprintf "'%s' and '%s' differ; %A" (getfullpath cfg outFile) (getfullpath cfg expectedFile) diff) + // // Shadowcopy does not work for public signed assemblies @@ -759,7 +838,7 @@ module CoreTests = // // "%FSI%" %fsi_flags% --shadowcopyreferences- < test1.fsx // [] - let ``sigs pos26`` () = + let ``sigs pos24`` () = let cfg = testConfig "typecheck/sigs" - fsc cfg "%s --target:exe -o:pos26.exe" cfg.fsc_flags ["pos26.fsi"; "pos26.fs"] - peverify cfg "pos26.exe" + fsc cfg "%s --target:exe -o:pos24.exe" cfg.fsc_flags ["pos24.fs"] + peverify cfg "pos24.exe" [] let ``sigs pos25`` () = @@ -2495,7 +2574,13 @@ module TypecheckTests = peverify cfg "pos25.exe" [] - let ``sigs pos27`` () = + let ``sigs pos26`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:exe -o:pos26.exe" cfg.fsc_flags ["pos26.fsi"; "pos26.fs"] + peverify cfg "pos26.exe" + + [] + let ``sigs pos27`` () = let cfg = testConfig "typecheck/sigs" fsc cfg "%s --target:exe -o:pos27.exe" cfg.fsc_flags ["pos27.fs"] peverify cfg "pos27.exe" @@ -2518,12 +2603,6 @@ module TypecheckTests = fsc cfg "%s --target:exe -o:pos30.exe --warnaserror+" cfg.fsc_flags ["pos30.fs"] peverify cfg "pos30.exe" - [] - let ``sigs pos24`` () = - let cfg = testConfig "typecheck/sigs" - fsc cfg "%s --target:exe -o:pos24.exe" cfg.fsc_flags ["pos24.fs"] - peverify cfg "pos24.exe" - [] let ``sigs pos31`` () = let cfg = testConfig "typecheck/sigs" @@ -2548,12 +2627,74 @@ module TypecheckTests = fsc cfg "%s --target:library -o:pos34.dll --warnaserror" cfg.fsc_flags ["pos34.fs"] peverify cfg "pos34.dll" + // We also run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs pos34 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:pos34-preview.dll --langversion:preview --warnaserror" cfg.fsc_flags ["pos34.fs"] + peverify cfg "pos34-preview.dll" + [] let ``sigs pos35`` () = let cfg = testConfig "typecheck/sigs" fsc cfg "%s --target:library -o:pos35.dll --warnaserror" cfg.fsc_flags ["pos35.fs"] peverify cfg "pos35.dll" + [] + let ``sigs pos35 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:pos35.dll --warnaserror --langversion:preview" cfg.fsc_flags ["pos35.fs"] + peverify cfg "pos35.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs pos36 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:pos36.dll --langversion:preview --warnaserror" cfg.fsc_flags ["pos36.fs"] + peverify cfg "pos36.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen1 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen1.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen1.fs"] + peverify cfg "widen1.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen2 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen2.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen2.fs"] + peverify cfg "widen2.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen3 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen3.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen3.fs"] + peverify cfg "widen3.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen4 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen4.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen4.fs"] + peverify cfg "widen4.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen5 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen5.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen5.fs"] + peverify cfg "widen5.dll" + + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``sigs widen6 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:widen6.dll --langversion:preview --warnaserror" cfg.fsc_flags ["widen6.fs"] + peverify cfg "widen6.dll" + [] let ``sigs pos36-srtp`` () = let cfg = testConfig "typecheck/sigs" @@ -3048,8 +3189,9 @@ module TypecheckTests = [] let ``type check neg93`` () = singleNegTest (testConfig "typecheck/sigs") "neg93" - [] - let ``type check neg94`` () = singleNegTest (testConfig "typecheck/sigs") "neg94" + // The code in the "pre" file no longer compiles in "preview". This is by design - an extra type annotation is needed. + [] + let ``type check neg94 langversion 4_7`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "4.7" "neg94" [] let ``type check neg95`` () = singleNegTest (testConfig "typecheck/sigs") "neg95" @@ -3117,10 +3259,22 @@ module TypecheckTests = [] let ``type check neg116`` () = singleNegTest (testConfig "typecheck/sigs") "neg116" - [] + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``type check neg116 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg116" + + [] let ``type check neg117`` () = singleNegTest (testConfig "typecheck/sigs") "neg117" - [] + // We also run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + // This test can replace the one above once RFC-1043 is activated in default language version + [] + let ``type check neg117 preview`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:neg117-preview.dll --langversion:preview --warnaserror" cfg.fsc_flags ["neg117.fs"] + peverify cfg "neg117-preview.dll" + + [] let ``type check neg118`` () = singleNegTest (testConfig "typecheck/sigs") "neg118" [] @@ -3129,35 +3283,116 @@ module TypecheckTests = [] let ``type check neg119b`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "7.0" "neg119b" - [] + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] let ``type check neg120`` () = singleNegTest (testConfig "typecheck/sigs") "neg120" - [] + [] + let ``type check neg120 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg120" + + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] let ``type check neg121`` () = singleNegTest (testConfig "typecheck/sigs") "neg121" - [] + // The code in this test fails to compile even when FS-1043 is enabled - this is expected. + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and may be affected by RFC FS-1043 + [] + let ``type check neg121 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg121" + + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] let ``type check neg122`` () = singleNegTest (testConfig "typecheck/sigs") "neg122" - [] - let ``type check neg123`` () = singleNegTest (testConfig "typecheck/sigs") "neg123" + [] + let ``type check neg122 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg122" - [] - let ``type check neg124`` () = singleNegTest (testConfig "typecheck/sigs") "neg124" + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] + let ``type check neg123`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "" "neg123" - [] - let ``type check neg125`` () = singleNegTest (testConfig "typecheck/sigs") "neg125" + [] + let ``type check neg123 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg123" - [] - let ``type check neg126`` () = singleNegTest (testConfig "typecheck/sigs") "neg126" + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] + let ``type check neg124`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "" "neg124" - [] - let ``type check neg127`` () = singleNegTest (testConfig "typecheck/sigs") "neg127" + [] + let ``type check neg124 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg124" - [] - let ``type check neg128`` () = singleNegTest (testConfig "typecheck/sigs") "neg128" + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:default and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] + let ``type check neg125`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "" "neg125" - [] - let ``type check neg129`` () = singleNegTest (testConfig "typecheck/sigs") "neg129" + [] + let ``type check neg125 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg125" + + // The code in this test starts to compile once FS-1043 is enabled. + // + // We run this with --langversion:preview because it is an SRTP test and RFC FS-1043 is enabled in preview + [] + let ``type check neg126`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "4.7" "neg126" + + [] + let ``type check neg126 preview positive`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:neg126-preview.dll --langversion:preview --warnaserror" cfg.fsc_flags ["neg126.fs"] + peverify cfg "neg126-preview.dll" + + // The code in this test does not compile (in any language version) + // + // We compile with both --langversion:4.7 and no --langversion:preview + // because it is an SRTP test and we want to check it is not affected by RFC FS-1043 + [] + let ``type check neg127 4_7`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "" "neg127" + + [] + let ``type check neg127 preview`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg127" + + // The code in this test starts to compile once FS-1043 is enabled. + [] + let ``type check neg128 4_7`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "4.7" "neg128" + + [] + let ``type check neg128 preview positive`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:neg128-preview.dll --langversion:preview --warnaserror" cfg.fsc_flags ["neg128.fs"] + peverify cfg "neg128-preview.dll" + + // The code in this test starts to compile once FS-1043 is enabled. + [] + let ``type check neg129 6_0`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "6.0" "neg129" + + [] + let ``type check neg129 preview positive`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:neg129-preview.dll --langversion:preview --warnaserror" cfg.fsc_flags ["neg129.fs"] + peverify cfg "neg129-preview.dll" [] let ``type check neg130`` () = singleNegTest (testConfig "typecheck/sigs") "neg130" @@ -3171,6 +3406,37 @@ module TypecheckTests = [] let ``type check neg133`` () = singleNegTest (testConfig "typecheck/sigs") "neg133" + [] + let ``type check neg140 4_7`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "4.7" "neg140" + + [] + let ``type check neg140 preview`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg140" + + [] + // This code must pass compilation with /langversion:4.7 on because RFC FS-1043 is not supported + let ``type check neg141 4_7`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s -o:neg141-4.7.exe --langversion:4.7 --warnaserror" cfg.fsc_flags ["neg141.fs"] + peverify cfg "neg141-4.7.exe" + exec cfg ("." ++ "neg141-4.7.exe") "" + + [] + // This code must not pass compilation with /langversion:preview on because RFC FS-1043 is supported + let ``type check neg141 preview`` () = + singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg141" + + // The code in the neg133 test does not compile (in any language version). + // However it raises an internal error without RFC-1043 and so we don't + // run it under that configuration. + // + //[] + //let ``type check neg133`` () = singleNegTest (testConfig "typecheck/sigs") "neg133" + + [] + let ``type check neg142 preview`` () = singleVersionedNegTest (testConfig "typecheck/sigs") "preview" "neg142" + [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg116.preview.bsl b/tests/fsharp/typecheck/sigs/neg116.preview.bsl new file mode 100644 index 00000000000..8613d44041c --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg116.preview.bsl @@ -0,0 +1,10 @@ + +neg116.fs(10,44,10,45): typecheck error FS0043: No overloads match for method 'op_Multiply'. + +Known return type: ^a + +Known type parameters: < float , Polynomial > + +Available overloads: + - static member Polynomial.( * ) : s:Complex * p:Polynomial -> Polynomial // Argument 's' doesn't match + - static member Polynomial.( * ) : s:decimal * p:Polynomial -> Polynomial // Argument 's' doesn't match diff --git a/tests/fsharp/typecheck/sigs/neg120.preview.bsl b/tests/fsharp/typecheck/sigs/neg120.preview.bsl new file mode 100644 index 00000000000..e0b1aebc7b2 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg120.preview.bsl @@ -0,0 +1,13 @@ + +neg120.fs(95,18,95,21): typecheck error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. No overloads match for method 'op_GreaterGreaterEquals'. + +Known return type: obj + +Known type parameters: < Id , (int -> obj) > + +Available overloads: + - static member Bind.(>>=) : source: 'T option * f: ('T -> 'U option) -> 'U option // Argument 'source' doesn't match + - static member Bind.(>>=) : source: Async<'T> * f: ('T -> Async<'a1>) -> Async<'a1> // Argument 'source' doesn't match + - static member Bind.(>>=) : source: Id<'T> * f: ('T -> Id<'U>) -> Id<'U> // Argument 'f' doesn't match + - static member Bind.(>>=) : source: Lazy<'T> * f: ('T -> Lazy<'U>) -> Lazy<'U> // Argument 'source' doesn't match + - static member Bind.(>>=) : source: Task<'T> * f: ('T -> Task<'U>) -> Task<'U> // Argument 'source' doesn't match Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg121.preview.bsl b/tests/fsharp/typecheck/sigs/neg121.preview.bsl new file mode 100644 index 00000000000..b32b35aa102 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg121.preview.bsl @@ -0,0 +1,2 @@ + +neg121.fs(19,28,19,38): typecheck error FS0071: Type constraint mismatch when applying the default type 'int' for a type inference variable. Method or object constructor 'ParseApply' not found Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg122.preview.bsl b/tests/fsharp/typecheck/sigs/neg122.preview.bsl new file mode 100644 index 00000000000..a2dccc17ac0 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg122.preview.bsl @@ -0,0 +1,2 @@ + +neg122.fs(19,65,19,98): typecheck error FS0001: Method or object constructor 'ParseApply' not found diff --git a/tests/fsharp/typecheck/sigs/neg123.preview.bsl b/tests/fsharp/typecheck/sigs/neg123.preview.bsl new file mode 100644 index 00000000000..a944f087500 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg123.preview.bsl @@ -0,0 +1,2 @@ + +neg123.fs(19,18,19,27): typecheck error FS0003: This value is not a function and cannot be applied. diff --git a/tests/fsharp/typecheck/sigs/neg124.preview.bsl b/tests/fsharp/typecheck/sigs/neg124.preview.bsl new file mode 100644 index 00000000000..5b13ecc8bd6 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg124.preview.bsl @@ -0,0 +1,16 @@ + +neg124.fs(39,27,39,35): typecheck error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. No overloads match for method 'unsigned_witness'. + +Known return type: uint8 + +Known type parameter: < obj > + +Available overloads: + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: byte -> byte // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: int16 -> uint16 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: int32 -> uint32 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: int64 -> uint64 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: sbyte -> uint8 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: uint16 -> uint16 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: uint32 -> uint32 // Argument 'x' doesn't match + - static member Negative_SelectOverloadedWitnessBasedOnInputAndReturnTypeWithoutOutputTypeSelector.witnesses.unsigned_witness: x: uint64 -> uint64 // Argument 'x' doesn't match Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg125.preview.bsl b/tests/fsharp/typecheck/sigs/neg125.preview.bsl new file mode 100644 index 00000000000..17a6052b4e5 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg125.preview.bsl @@ -0,0 +1,273 @@ + +neg125.fs(39,30,39,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(40,30,40,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int64 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(41,31,41,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: bigint + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(42,30,42,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: float + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(43,30,43,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: sbyte + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(44,30,44,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int16 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(45,29,45,31): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: byte + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(46,31,46,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint16 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(47,31,47,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(48,32,48,34): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint64 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(49,33,49,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: float32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(50,33,50,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: decimal + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg125.fs(51,33,51,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: Complex + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 diff --git a/tests/fsharp/typecheck/sigs/neg126.bsl b/tests/fsharp/typecheck/sigs/neg126.4.7.bsl similarity index 100% rename from tests/fsharp/typecheck/sigs/neg126.bsl rename to tests/fsharp/typecheck/sigs/neg126.4.7.bsl diff --git a/tests/fsharp/typecheck/sigs/neg126.fs b/tests/fsharp/typecheck/sigs/neg126.fs index 232a35bb9c1..a5c0ed20238 100644 --- a/tests/fsharp/typecheck/sigs/neg126.fs +++ b/tests/fsharp/typecheck/sigs/neg126.fs @@ -17,8 +17,8 @@ module Neg126 // // That is, the code is not generic at all, because the F# compiler thinks that it commit to the one and only witness. // -// This test exists to pin down that we get a warning produced saying ^a has been instantiated to "sbyte" - +// For pre-FS0143 this test exists to pin down that we get a warning produced saying ^a has been instantiated to "sbyte" +// For post-FS0143 this test exists to check that the code now compiles module Negative_SelectOverloadedWitnessBasedOnInputTypeOneWitness = type witnesses = static member inline foo_witness (x : sbyte) : byte = byte x diff --git a/tests/fsharp/typecheck/sigs/neg127.preview.bsl b/tests/fsharp/typecheck/sigs/neg127.preview.bsl new file mode 100644 index 00000000000..76b3c8e353f --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg127.preview.bsl @@ -0,0 +1,273 @@ + +neg127.fs(47,30,47,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(48,30,48,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int64 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(49,31,49,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: bigint + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(50,30,50,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: float + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(51,30,51,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: sbyte + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(52,30,52,32): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: int16 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(53,29,53,31): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: byte + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(54,31,54,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint16 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(55,31,55,33): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(56,32,56,34): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: uint64 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(57,33,57,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: float32 + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(58,33,58,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: decimal + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 + +neg127.fs(59,33,59,35): typecheck error FS0001: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. + +Known return type: Complex + +Known type parameter: < BigInteger > + +Candidates: + - static member witnesses.convert_witness: x: bigint -> Complex + - static member witnesses.convert_witness: x: bigint -> bigint + - static member witnesses.convert_witness: x: bigint -> byte + - static member witnesses.convert_witness: x: bigint -> decimal + - static member witnesses.convert_witness: x: bigint -> float + - static member witnesses.convert_witness: x: bigint -> float32 + - static member witnesses.convert_witness: x: bigint -> int + - static member witnesses.convert_witness: x: bigint -> int16 + - static member witnesses.convert_witness: x: bigint -> int64 + - static member witnesses.convert_witness: x: bigint -> sbyte + - static member witnesses.convert_witness: x: bigint -> uint16 + - static member witnesses.convert_witness: x: bigint -> uint32 + - static member witnesses.convert_witness: x: bigint -> uint64 diff --git a/tests/fsharp/typecheck/sigs/neg128.bsl b/tests/fsharp/typecheck/sigs/neg128.4.7.bsl similarity index 100% rename from tests/fsharp/typecheck/sigs/neg128.bsl rename to tests/fsharp/typecheck/sigs/neg128.4.7.bsl diff --git a/tests/fsharp/typecheck/sigs/neg128.fs b/tests/fsharp/typecheck/sigs/neg128.fs index b936ee254b6..ecc625dd56b 100644 --- a/tests/fsharp/typecheck/sigs/neg128.fs +++ b/tests/fsharp/typecheck/sigs/neg128.fs @@ -32,5 +32,5 @@ module Negative_SelectOverloadedWitnessBasedOnReturnTypeByPassingDummyArgumentGe let v1 : int32 = convert 777I let v2 : int64 = convert 777I - // This gives an error, because solving kicks in once all selector types are known + // Pre-FS1043 this gives an error, because solving kicks in once all selector types are known. Post-FS1043 it should compile let inline inst (num: bigint) : 'output = convert num diff --git a/tests/fsharp/typecheck/sigs/neg129.bsl b/tests/fsharp/typecheck/sigs/neg129.6.0.bsl similarity index 100% rename from tests/fsharp/typecheck/sigs/neg129.bsl rename to tests/fsharp/typecheck/sigs/neg129.6.0.bsl diff --git a/tests/fsharp/typecheck/sigs/neg129.fs b/tests/fsharp/typecheck/sigs/neg129.fs index d65671900bd..1daa9c1c2db 100644 --- a/tests/fsharp/typecheck/sigs/neg129.fs +++ b/tests/fsharp/typecheck/sigs/neg129.fs @@ -1,5 +1,5 @@ module Neg129 - +// The code in this test starts to compile once FS-1043 is enabled. // Variation on test case mentioned in https://github.com/dotnet/fsharp/pull/6805#issuecomment-580368303 // // This removes ^output as a type selector for the witness, but continues to pass a dummy ^output diff --git a/tests/fsharp/typecheck/sigs/neg132.bsl b/tests/fsharp/typecheck/sigs/neg132.bsl index 5bed67dbd41..613003e7312 100644 --- a/tests/fsharp/typecheck/sigs/neg132.bsl +++ b/tests/fsharp/typecheck/sigs/neg132.bsl @@ -7,4 +7,4 @@ Known types of arguments: 'a * ('b -> int) Candidates: - static member OverloadsWithSrtp.SomeMethod: x: 'T list * f: ('T list -> int) -> int - - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: (^T -> int) -> int when ^T: (member Length: int) + - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: ( ^T -> int) -> int when ^T: (member Length: int) diff --git a/tests/fsharp/typecheck/sigs/neg132.preview.bsl b/tests/fsharp/typecheck/sigs/neg132.preview.bsl new file mode 100644 index 00000000000..6a87ecd0eef --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg132.preview.bsl @@ -0,0 +1,6 @@ + +neg132.fs(24,24,24,33): typecheck error FS0043: Type constraint mismatch. The type + ''d -> 'e' +is not compatible with type + ''a -> 'f' + diff --git a/tests/fsharp/typecheck/sigs/neg140.bsl b/tests/fsharp/typecheck/sigs/neg140.bsl new file mode 100644 index 00000000000..a148a4ec77b --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg140.bsl @@ -0,0 +1,256 @@ + +neg140.fs(143,23,143,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(143,27,143,29): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(144,22,144,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(144,25,144,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(145,22,145,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(145,25,145,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(146,22,146,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(146,25,146,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(147,22,147,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(147,25,147,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(148,22,148,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(148,25,148,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(149,22,149,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(149,25,149,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(150,22,150,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(150,25,150,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(151,22,151,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(151,25,151,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(152,22,152,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(152,25,152,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(153,22,153,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(153,25,153,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(154,22,154,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(154,25,154,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(155,22,155,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(155,25,155,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(156,22,156,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(156,25,156,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(157,22,157,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(157,25,157,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(158,22,158,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(158,25,158,27): typecheck error FS0039: The value or constructor 'P1' is not defined. + +neg140.fs(160,22,160,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(160,25,160,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(161,22,161,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(161,25,161,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(162,22,162,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(162,25,162,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(163,22,163,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(163,25,163,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(164,22,164,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(164,25,164,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(165,22,165,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(165,25,165,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(166,22,166,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(166,25,166,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(167,22,167,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(167,25,167,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(168,22,168,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(168,25,168,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(169,22,169,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(169,25,169,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(170,22,170,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(170,25,170,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(171,22,171,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(171,25,171,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(172,22,172,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(172,25,172,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(173,22,173,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(173,25,173,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(174,22,174,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(174,25,174,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(175,22,175,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(175,25,175,27): typecheck error FS0039: The value or constructor 'P2' is not defined. + +neg140.fs(177,22,177,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(177,25,177,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(178,22,178,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(178,25,178,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(179,22,179,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(179,25,179,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(180,22,180,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(180,25,180,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(181,22,181,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(181,25,181,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(182,22,182,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(182,25,182,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(183,22,183,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(183,25,183,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(184,22,184,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(184,25,184,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(185,22,185,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(185,25,185,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(186,22,186,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(186,25,186,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(187,22,187,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(187,25,187,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(188,22,188,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(188,25,188,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(189,22,189,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(189,25,189,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(190,22,190,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(190,25,190,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(191,22,191,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(191,25,191,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(192,22,192,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(192,25,192,27): typecheck error FS0039: The value or constructor 'P3' is not defined. + +neg140.fs(194,22,194,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(194,25,194,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(195,22,195,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(195,25,195,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(196,22,196,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(196,25,196,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(197,22,197,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(197,25,197,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(198,22,198,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(198,25,198,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(199,22,199,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(199,25,199,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(200,22,200,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(200,25,200,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(201,22,201,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(201,25,201,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(202,22,202,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(202,25,202,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(203,22,203,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(203,25,203,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(204,22,204,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(204,25,204,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(205,22,205,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(205,25,205,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(206,22,206,68): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(206,25,206,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(207,22,207,70): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(207,25,207,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(208,22,208,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(208,25,208,27): typecheck error FS0039: The value or constructor 'P4' is not defined. + +neg140.fs(209,22,209,69): typecheck error FS0001: The types 'int32, uint32' do not support the operator '+' + +neg140.fs(209,25,209,27): typecheck error FS0039: The value or constructor 'P4' is not defined. diff --git a/tests/fsharp/typecheck/sigs/neg140.fs b/tests/fsharp/typecheck/sigs/neg140.fs new file mode 100644 index 00000000000..5a5894ea72e --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg140.fs @@ -0,0 +1,214 @@ +module Neg140 + +module SmartHashUtils = + let ByteToUInt (array:byte[]) offset length endian = + + let temp:uint32[] = Array.create (length / 4) (uint32 0) + let ff = uint32 0xff + + match endian with + | 0 -> + let funn i n = + (uint32 array.[offset + i*4] &&& ff) ||| + ((uint32 array.[offset + i*4+1] &&& ff) <<< 8) ||| + ((uint32 array.[offset + i*4+2] &&& ff) <<< 16) ||| + ((uint32 array.[offset + i*4+3] &&& ff) <<< 24) + Array.mapi funn temp + | _ -> + let funn i n = + ((uint32 array.[offset + i*4] &&& ff) <<< 24) ||| + ((uint32 array.[offset + i*4+1] &&& ff) <<< 16) ||| + ((uint32 array.[offset + i*4+2] &&& ff) <<< 8) ||| + (uint32 array.[offset + i*4+3] &&& ff) + Array.mapi funn temp + + + let UIntToByte (array:uint32[]) offset length endian = + let temp:byte[] = Array.create (length * 4) (byte 0) + + match endian with + | 0 -> + let funn i n = byte (array.[offset + i/4] >>> (i%4 * 8)) + Array.mapi funn temp + | _ -> + let funn i n = byte (array.[offset + i/4] >>> ((3 - i%4) * 8)) + Array.mapi funn temp + + + let ULongToByte (array:uint64[]) offset length endian = + let temp:byte[] = Array.create (length * 8) (byte 0) + + match endian with + | 0 -> + let funn i n = byte (array.[offset + i/8] >>> (i%8 * 8)) + Array.mapi funn temp + | _ -> + let funn i n = byte (array.[offset + i/8] >>> ((7 - i%8) * 8)) + Array.mapi funn temp + + + let LS (x:uint32) n = uint32 ((x <<< n) ||| (x >>> (32 - n))) + let RS (x:uint32) n = uint32 ((x >>> n) ||| (x <<< (32 - n))) + +module SmartHashBlock = + open System.Security.Cryptography + + [] + type BlockHashAlgorithm() = + inherit HashAlgorithm() + ///The size in bytes of an individual block. + let mutable blockSize = 1 + ///The length of bytes, that have been processed. + ///This number includes the number of bytes currently waiting in the buffer. + let mutable count:uint64 = uint64 0 + ///Buffer for storing leftover bytes that are waiting to be processed. + let mutable buffer = Array.zeroCreate blockSize + ///The number of bytes currently in the Buffer waiting to be processed. + let mutable bufferCount = 0 + + member b.BlockSize with get() = blockSize and set(v) = blockSize <- v + member b.BufferCount with get() = bufferCount and set(v) = bufferCount <- v + member b.Count with get() = count and set(v) = count <- v + + default x.Initialize() = + count <- uint64 0 + bufferCount <- 0 + buffer <- Array.zeroCreate blockSize + + default x.HashCore(array, ibStart, cbSize) = + //let engineUpdate input offset' length' = + let mutable offset = ibStart + let mutable length = cbSize + count <- count + (uint64 length) + + if ((bufferCount > 0) && ((bufferCount + length) >= blockSize)) then + let off = blockSize - bufferCount + Array.blit array offset buffer bufferCount off + offset <- offset + off + length <- length - off + bufferCount <- 0 + x.BlockTransform (buffer, 0) + + let numBlocks = length / blockSize + for i in 0..(numBlocks-1) do + x.BlockTransform (array, (offset + i * blockSize)) + + let bytesLeft = length % blockSize + + if (bytesLeft <> 0) then + Array.blit array (offset + (length - bytesLeft)) buffer bufferCount bytesLeft + bufferCount <- bufferCount + bytesLeft + + abstract BlockTransform: (byte[] * int) -> unit + + member x.CreatePadding(minSize, append) = + let mutable paddingSize = x.BlockSize - ((int x.Count) % x.BlockSize) + + if (paddingSize < minSize) then paddingSize <- paddingSize + x.BlockSize + + let Padding = Array.create paddingSize (byte 0) + Padding.[0] <- append + Padding + +module SmartHashMD5 = + open SmartHashUtils + open SmartHashBlock + + + type MD5() as this = + inherit BlockHashAlgorithm() + ///The size in bytes of an individual block. + let mutable state:int32[] = null + + do this.BlockSize <- 64 + do this.HashSizeValue <- 128 + do state <- Array.zeroCreate 4 + do this.Initialize() + + override x.Initialize() = + base.Initialize() + state.[0] <- 0x67452301 + state.[1] <- 0xEFCDAB89 + state.[2] <- 0x98BADCFE + state.[3] <- 0x10325476 + + member x.BlockTransform(data, iOffset) = + let mutable A = state.[0] + let mutable B = state.[3] + let mutable C = state.[2] + let mutable D = state.[1] + + let X = ByteToUInt data iOffset 64 0 + + A <- D + LS (P1 D C B + A + X.[0] + uint32 0xD76AA478) 7 + B <- A + LS(P1 A D C + B + X.[1] + uint32 0xE8C7B756) 12 + C <- B + LS(P1 B A D + C + X.[2] + uint32 0x242070DB) 17 + D <- C + LS(P1 C B A + D + X.[3] + uint32 0xC1BDCEEE) 22 + A <- D + LS(P1 D C B + A + X.[4] + uint32 0xF57C0FAF) 7 + B <- A + LS(P1 A D C + B + X.[5] + uint32 0x4787C62A) 12 + C <- B + LS(P1 B A D + C + X.[6] + uint32 0xA8304613) 17 + D <- C + LS(P1 C B A + D + X.[7] + uint32 0xFD469501) 22 + A <- D + LS(P1 D C B + A + X.[8] + uint32 0x698098D8) 7 + B <- A + LS(P1 A D C + B + X.[9] + uint32 0x8B44F7AF) 12 + C <- B + LS(P1 B A D + C + X.[10] + uint32 0xFFFF5BB1) 17 + D <- C + LS(P1 C B A + D + X.[11] + uint32 0x895CD7BE) 22 + A <- D + LS(P1 D C B + A + X.[12] + uint32 0x6B901122) 7 + B <- A + LS(P1 A D C + B + X.[13] + uint32 0xFD987193) 12 + C <- B + LS(P1 B A D + C + X.[14] + uint32 0xA679438E) 17 + D <- C + LS(P1 C B A + D + X.[15] + uint32 0x49B40821) 22 + + A <- D + LS(P2 D C B + A + X.[1] + uint32 0xF61E2562) 5 + B <- A + LS(P2 A D C + B + X.[6] + uint32 0xC040B340) 9 + C <- B + LS(P2 B A D + C + X.[11] + uint32 0x265E5A51) 14 + D <- C + LS(P2 C B A + D + X.[0] + uint32 0xE9B6C7AA) 20 + A <- D + LS(P2 D C B + A + X.[5] + uint32 0xD62F105D) 5 + B <- A + LS(P2 A D C + B + X.[10] + uint32 0x02441453) 9 + C <- B + LS(P2 B A D + C + X.[15] + uint32 0xD8A1E681) 14 + D <- C + LS(P2 C B A + D + X.[4] + uint32 0xE7D3FBC8) 20 + A <- D + LS(P2 D C B + A + X.[9] + uint32 0x21E1CDE6) 5 + B <- A + LS(P2 A D C + B + X.[14] + uint32 0xC33707D6) 9 + C <- B + LS(P2 B A D + C + X.[3] + uint32 0xF4D50D87) 14 + D <- C + LS(P2 C B A + D + X.[8] + uint32 0x455A14ED) 20 + A <- D + LS(P2 D C B + A + X.[13] + uint32 0xA9E3E905) 5 + B <- A + LS(P2 A D C + B + X.[2] + uint32 0xFCEFA3F8) 9 + C <- B + LS(P2 B A D + C + X.[7] + uint32 0x676F02D9) 14 + D <- C + LS(P2 C B A + D + X.[12] + uint32 0x8D2A4C8A) 20 + + A <- D + LS(P3 D C B + A + X.[5] + uint32 0xFFFA3942) 4 + B <- A + LS(P3 A D C + B + X.[8] + uint32 0x8771F681) 11 + C <- B + LS(P3 B A D + C + X.[11] + uint32 0x6D9D6122) 16 + D <- C + LS(P3 C B A + D + X.[14] + uint32 0xFDE5380C) 23 + A <- D + LS(P3 D C B + A + X.[1] + uint32 0xA4BEEA44) 4 + B <- A + LS(P3 A D C + B + X.[4] + uint32 0x4BDECFA9) 11 + C <- B + LS(P3 B A D + C + X.[7] + uint32 0xF6BB4B60) 16 + D <- C + LS(P3 C B A + D + X.[10] + uint32 0xBEBFBC70) 23 + A <- D + LS(P3 D C B + A + X.[13] + uint32 0x289B7EC6) 4 + B <- A + LS(P3 A D C + B + X.[0] + uint32 0xEAA127FA) 11 + C <- B + LS(P3 B A D + C + X.[3] + uint32 0xD4EF3085) 16 + D <- C + LS(P3 C B A + D + X.[6] + uint32 0x04881D05) 23 + A <- D + LS(P3 D C B + A + X.[9] + uint32 0xD9D4D039) 4 + B <- A + LS(P3 A D C + B + X.[12] + uint32 0xE6DB99E5) 11 + C <- B + LS(P3 B A D + C + X.[15] + uint32 0x1FA27CF8) 16 + D <- C + LS(P3 C B A + D + X.[2] + uint32 0xC4AC5665) 23 + + A <- D + LS(P4 D C B + A + X.[0] + uint32 0xF4292244) 6 + B <- A + LS(P4 A D C + B + X.[7] + uint32 0x432AFF97) 10 + C <- B + LS(P4 B A D + C + X.[14] + uint32 0xAB9423A7) 15 + D <- C + LS(P4 C B A + D + X.[5] + uint32 0xFC93A039) 21 + A <- D + LS(P4 D C B + A + X.[12] + uint32 0x655B59C3) 6 + B <- A + LS(P4 A D C + B + X.[3] + uint32 0x8F0CCC92) 10 + C <- B + LS(P4 B A D + C + X.[10] + uint32 0xFFEFF47D) 15 + D <- C + LS(P4 C B A + D + X.[1] + uint32 0x85845DD1) 21 + A <- D + LS(P4 D C B + A + X.[8] + uint32 0x6FA87E4F) 6 + B <- A + LS(P4 A D C + B + X.[15] + uint32 0xFE2CE6E0) 10 + C <- B + LS(P4 B A D + C + X.[6] + uint32 0xA3014314) 15 + D <- C + LS(P4 C B A + D + X.[13] + uint32 0x4E0811A1) 21 + A <- D + LS(P4 D C B + A + X.[4] + uint32 0xF7537E82) 6 + B <- A + LS(P4 A D C + B + X.[11] + uint32 0xBD3AF235) 10 + C <- B + LS(P4 B A D + C + X.[2] + uint32 0x2AD7D2BB) 15 + D <- C + LS(P4 C B A + D + X.[9] + uint32 0xEB86D391) 21 + + state.[0] <- state.[0] + A + state.[3] <- state.[3] + B + state.[2] <- state.[2] + C + state.[1] <- state.[1] + D diff --git a/tests/fsharp/typecheck/sigs/neg141.bsl b/tests/fsharp/typecheck/sigs/neg141.bsl new file mode 100644 index 00000000000..582828cd78f --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg141.bsl @@ -0,0 +1,6 @@ + +neg141.fs(24,24,24,33): typecheck error FS0043: Type constraint mismatch. The type + ''d -> 'e' +is not compatible with type + ''a -> 'f' + diff --git a/tests/fsharp/typecheck/sigs/neg141.fs b/tests/fsharp/typecheck/sigs/neg141.fs new file mode 100644 index 00000000000..31975e04fa2 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg141.fs @@ -0,0 +1,27 @@ + +module Neg141 + +// This code starts failing to compile once RFC-1043 is enabled +// +// This is because the constraint relies on return types in the set of support types. +// +// This leaves unexpected ambiguity in common code especially when the shape of internal collections is potentially +// ambiguous internally in function implementations. +// +// Prior to RFC-1043 this ambiguity was resolved by applying weak resolution eagerly. + +// See https://github.com/fsharp/fslang-design/issues/435#issuecomment-584192749 +let inline InvokeMap (mapping: ^F) (source: ^I) : ^R = + ((^I or ^R) : (static member Map : ^I * ^F -> ^R) source, mapping) + +// A simulated collection with a'Map' witness +type Coll<'T>(x: 'T) = + member _.X = x + static member Map (source: Coll<'a>, mapping: 'a->'b) : Coll<'b> = new Coll<'b>(mapping source.X) + +// What's the return collection type of the inner `InvokeMap` call? We only know once we apply weak resolution. +let inline AddTwice (x: Coll<'a>) (v: 'a) : Coll<'a> = + InvokeMap ((+) v) (InvokeMap ((+) v) x) + +let v1 = AddTwice (Coll(3)) 2 +let v2 = AddTwice (Coll(3uy)) 2uy diff --git a/tests/fsharp/typecheck/sigs/neg142.fs b/tests/fsharp/typecheck/sigs/neg142.fs new file mode 100644 index 00000000000..610d7706cb8 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg142.fs @@ -0,0 +1,47 @@ +module Neg133 + +// This code should fail to compile regardless RFC-1043 + +let inline CallReturn< ^M, ^R, 'T when (^M or ^R) : (static member Return : unit -> ('T -> ^R))> () = + ((^M or ^R) : (static member Return : unit -> ('T -> ^R)) ()) + +let inline CallApply< ^M, ^I1, ^I2, ^R when (^M or ^I1 or ^I2) : (static member Apply : ^I1 * ^I2 -> ^R)> (input1: ^I1, input2: ^I2) = + ((^M or ^I1 or ^I2) : (static member Apply : ^I1 * ^I2 -> ^R) input1, input2) + +let inline CallMap< ^M, ^F, ^I, ^R when (^M or ^I or ^R) : (static member Map : ^F * ^I -> ^R)> (mapping: ^F, source: ^I) : ^R = + ((^M or ^I or ^R) : (static member Map : ^F * ^I -> ^R) mapping, source) + +let inline CallSequence< ^M, ^I, ^R when (^M or ^I) : (static member Sequence : ^I -> ^R)> (b: ^I) : ^R = + ((^M or ^I) : (static member Sequence : ^I -> ^R) b) + +type Return = class end + +type Apply = class end + +type Map = class end + +type Sequence = class end + +let inline InvokeReturn (x: 'T) : ^R = + CallReturn< Return , ^R , 'T> () x + +let inline InvokeApply (f: ^I1) (x: ^I2) : ^R = + CallApply(f, x) + +let inline InvokeMap (mapping: ^F) (source: ^I) : ^R = + CallMap (mapping, source) + +type Sequence with + static member inline Sequence (t: list>) : ^R = + List.foldBack (fun (x: 't option) (ys: ^R) -> InvokeApply (InvokeMap (fun x y -> x :: y) x) ys) t (InvokeReturn []) + +type Map with + static member Map (f: 'T->'U, x: option<_>) = Option.map f x + +type Apply with + static member Apply (f: option<_>, x: option<'T>) : option<'U> = failwith "" + +type Return with + static member Return () = fun x -> Some x : option<'a> +let res18() = + CallSequence [Some 3; Some 2; Some 1] diff --git a/tests/fsharp/typecheck/sigs/neg142.preview.bsl b/tests/fsharp/typecheck/sigs/neg142.preview.bsl new file mode 100644 index 00000000000..653b9b8e88d --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg142.preview.bsl @@ -0,0 +1,6 @@ + +neg142.fs(47,5,47,58): optimize error FS0071: Type constraint mismatch when applying the default type 'Microsoft.FSharp.Core.obj' for a type inference variable. Type constraint mismatch. The type + 'Microsoft.FSharp.Core.obj' +is not compatible with type + ''a Microsoft.FSharp.Core.option' + Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg21.bsl b/tests/fsharp/typecheck/sigs/neg21.bsl index d395b72b03b..de46028026e 100644 --- a/tests/fsharp/typecheck/sigs/neg21.bsl +++ b/tests/fsharp/typecheck/sigs/neg21.bsl @@ -7,9 +7,9 @@ neg21.fs(13,19,13,28): typecheck error FS0001: The unit of measure 'sqrm' does n neg21.fs(13,17,13,18): typecheck error FS0043: The unit of measure 'sqrm' does not match the unit of measure 's' -neg21.fs(14,19,14,23): typecheck error FS0001: The type 'float32' does not match the type 'float<'u>' +neg21.fs(14,19,14,23): typecheck error FS0001: The types 'float, float32' do not support the operator '/' -neg21.fs(14,17,14,18): typecheck error FS0043: The type 'float32' does not match the type 'float<'u>' +neg21.fs(14,17,14,18): typecheck error FS0043: The types 'float, float32' do not support the operator '/' neg21.fs(17,26,17,34): typecheck error FS0001: Type mismatch. Expecting a 'float' diff --git a/tests/fsharp/typecheck/sigs/neg45.bsl b/tests/fsharp/typecheck/sigs/neg45.bsl index 4fe0cd14a72..e58316fa5f0 100644 --- a/tests/fsharp/typecheck/sigs/neg45.bsl +++ b/tests/fsharp/typecheck/sigs/neg45.bsl @@ -97,6 +97,6 @@ neg45.fs(144,13,144,23): typecheck error FS0001: The type 'A1' does not support neg45.fs(145,13,145,23): typecheck error FS0001: The type 'A2' does not support the operator 'get_Name' -neg45.fs(146,13,146,23): typecheck error FS0001: The type 'B' has a method 'get_Name' (full name 'get_Name'), but the method is not static +neg45.fs(146,13,146,23): typecheck error FS0001: get_Name is not a static method neg45.fs(147,15,147,25): typecheck error FS0001: The type 'StaticMutableClassExplicit' does not support the operator 'get_Name' diff --git a/tests/fsharp/typecheck/sigs/neg60.bsl b/tests/fsharp/typecheck/sigs/neg60.bsl index 06ee5dbc874..5dc5a2b4af7 100644 --- a/tests/fsharp/typecheck/sigs/neg60.bsl +++ b/tests/fsharp/typecheck/sigs/neg60.bsl @@ -10,11 +10,11 @@ neg60.fs(71,36,71,40): typecheck error FS0043: The type 'System.Nullable' d neg60.fs(77,16,77,19): typecheck error FS0043: The type 'System.Nullable' does not support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. -neg60.fs(78,16,78,19): typecheck error FS0043: None of the types 'System.Nullable, int' support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. +neg60.fs(78,16,78,19): typecheck error FS0043: The types 'System.Nullable, int' do not support the operator '?>='. Consider opening the module 'Microsoft.FSharp.Linq.NullableOperators'. -neg60.fs(79,18,79,21): typecheck error FS0001: The type ''a * 'b' does not match the type 'int' +neg60.fs(79,18,79,21): typecheck error FS0001: Expecting a type supporting the operator '+' but given a tuple type -neg60.fs(79,15,79,16): typecheck error FS0043: The type ''a * 'b' does not match the type 'int' +neg60.fs(79,15,79,16): typecheck error FS0043: Expecting a type supporting the operator '+' but given a tuple type neg60.fs(80,22,80,25): typecheck error FS0001: Expecting a type supporting the operator '+' but given a tuple type diff --git a/tests/fsharp/typecheck/sigs/neg68.vsbsl b/tests/fsharp/typecheck/sigs/neg68.vsbsl index 15966211aa0..78c34e95539 100644 --- a/tests/fsharp/typecheck/sigs/neg68.vsbsl +++ b/tests/fsharp/typecheck/sigs/neg68.vsbsl @@ -3,6 +3,6 @@ neg68.fsx(71,46,71,47): parse error FS0010: Unexpected symbol ')' in binding. Ex neg68.fsx(71,46,71,47): parse error FS0010: Unexpected symbol ')' in binding. Expected incomplete structured construct at or before this point or other token. -neg68.fsx(123,40,123,41): typecheck error FS0001: The type 'bool' does not match the type 'float<'u>' +neg68.fsx(123,40,123,41): typecheck error FS0001: The types 'float, bool' do not support the operator '*' -neg68.fsx(123,38,123,39): typecheck error FS0043: The type 'bool' does not match the type 'float<'u>' +neg68.fsx(123,38,123,39): typecheck error FS0043: The types 'float, bool' do not support the operator '*' diff --git a/tests/fsharp/typecheck/sigs/neg74.vsbsl b/tests/fsharp/typecheck/sigs/neg74.vsbsl index 609fcc1264e..dbc4c7436ac 100644 --- a/tests/fsharp/typecheck/sigs/neg74.vsbsl +++ b/tests/fsharp/typecheck/sigs/neg74.vsbsl @@ -111,4 +111,4 @@ neg74.fsx(242,1,242,3): parse error FS0058: Possible incorrect indentation: this neg74.fsx(254,1,254,1): parse error FS0010: Incomplete structured construct at or before this point in implementation file -neg74.fsx(183,52,183,53): typecheck error FS0043: The type 'unit' does not match the type 'float' +neg74.fsx(183,52,183,53): typecheck error FS0043: The types 'float, unit' do not support the operator '+' diff --git a/tests/fsharp/typecheck/sigs/neg99.bsl b/tests/fsharp/typecheck/sigs/neg99.bsl index 9f6010f249d..1d050dfedd9 100644 --- a/tests/fsharp/typecheck/sigs/neg99.bsl +++ b/tests/fsharp/typecheck/sigs/neg99.bsl @@ -3,4 +3,4 @@ neg99.fs(19,16,19,64): typecheck error FS0077: Member constraints with the name neg99.fs(22,18,22,64): typecheck error FS0077: Member constraints with the name 'op_Explicit' are given special status by the F# compiler as certain .NET types are implicitly augmented with this member. This may result in runtime failures if you attempt to invoke the member constraint from your own code. -neg99.fs(25,39,25,43): typecheck error FS0043: The type 'CrashFSC.OhOh.MyByte' does not support a conversion to the type 'CrashFSC.OhOh.MyByte' +neg99.fs(25,39,25,43): typecheck error FS0043: The type 'MyByte' does not support a conversion to the type ''a' diff --git a/tests/fsharp/typecheck/sigs/neg99.fs b/tests/fsharp/typecheck/sigs/neg99.fs index 6c3007c74ab..b7d248f13ab 100644 --- a/tests/fsharp/typecheck/sigs/neg99.fs +++ b/tests/fsharp/typecheck/sigs/neg99.fs @@ -12,7 +12,7 @@ module OhOh = static member inline op_Explicit (x: int64): MyByte = MyByte (byte x) static member inline op_Explicit (x: float): MyByte = MyByte (byte x) - static member inline op_Explicit (MyByte x): 'a = failwith "cannot convert" + //static member inline op_Explicit (MyByte x): 'a = failwith "cannot convert" /// testing testing let inline ( !>>> ) (a: ^a) min: ^b option = diff --git a/tests/fsharp/typecheck/sigs/pos35.fs b/tests/fsharp/typecheck/sigs/pos35.fs index ed7c76a5617..463ff2fd46e 100644 --- a/tests/fsharp/typecheck/sigs/pos35.fs +++ b/tests/fsharp/typecheck/sigs/pos35.fs @@ -308,6 +308,8 @@ module PositiveTestCase3 = let inline CallQuackWitness (x: ^a, output: ^Output, witnesses: ^Witnesses) = ((^a or ^Output or ^Witnesses) : (static member QuackWitness : _*_*_ -> _) (x, output, witnesses)) + // This requires the rule "Weak resolution no longer forces overload resolution for SRTP constraints prior + // to generalizing inline code" that is part of RFC FS-1043 let inline call (x: seq< ^b > ) : ^Output = CallQuackWitness (x, Unchecked.defaultof< ^Output >, Unchecked.defaultof) diff --git a/tests/fsharp/typecheck/sigs/pos35.preview.bsl b/tests/fsharp/typecheck/sigs/pos35.preview.bsl new file mode 100644 index 00000000000..105d85ea227 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos35.preview.bsl @@ -0,0 +1,2 @@ + +pos35.fs(314,9,314,25): typecheck error FS0043: A unique overload for method 'Quack' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: static member Async.Quack : x:seq> -> Async>, static member Option.Quack : x:seq<'T option> -> seq<'T> option diff --git a/tests/fsharp/typecheck/sigs/pos36.fs b/tests/fsharp/typecheck/sigs/pos36.fs new file mode 100644 index 00000000000..b2be2a95ed2 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos36.fs @@ -0,0 +1,64 @@ +module Pos36 + +// Variation on test case mentioned in https://github.com/dotnet/fsharp/pull/6805#issuecomment-580368303 +// +// See also pos35.fs, neg125.fs, neg127.fs +// +// This no longer passes a dummy ^output but keeps ^output as a witness selector +// +// With RFC FS-1043 this now passes with the use of AllowOverloadByReturnType + +module Positive_SelectOverloadedWitnessBasedOnReturnTypeWithoutPassingDummyArgument = + open System + open System.Numerics + let _uint8max = bigint (uint32 Byte.MaxValue) + let _uint16max = bigint (uint32 UInt16.MaxValue) + let _uint32max = bigint UInt32.MaxValue + let _uint64max = bigint UInt64.MaxValue + type witnesses = + [] + static member inline convert_witness (x : bigint) = int (uint32 (x &&& _uint32max)) + [] + static member inline convert_witness (x : bigint) = int64 (uint64 (x &&& _uint64max)) + [] + static member inline convert_witness (x : bigint) = x + [] + static member inline convert_witness (x : bigint) = float x + [] + static member inline convert_witness (x : bigint) = sbyte (byte (x &&& _uint8max)) + [] + static member inline convert_witness (x : bigint) = int16 (uint16 (x &&& _uint16max)) + [] + static member inline convert_witness (x : bigint) = byte (x &&& _uint8max) + [] + static member inline convert_witness (x : bigint) = uint16 (x &&& _uint16max) + [] + static member inline convert_witness (x : bigint) = uint32 (x &&& _uint32max) + [] + static member inline convert_witness (x : bigint) = uint64 (x &&& _uint64max) + [] + static member inline convert_witness (x : bigint) = float32 x + [] + static member inline convert_witness (x : bigint) = decimal x + [] + static member inline convert_witness (x : bigint) = Complex(float x, 0.0) + + let inline call_convert_witness< ^witnesses, ^input, ^output when (^witnesses or ^input or ^output) : (static member convert_witness : ^input -> ^output)> (b : ^input) = + ((^witnesses or ^input or ^output) : (static member convert_witness : ^input -> ^output) (b)) + + let inline convert num = + call_convert_witness (num) + // These all cause errors + let v1 : int32 = convert 0I + let v2 : int64 = convert 0I + let v3 : bigint = convert 0I + let v4 : float = convert 0I + let v5 : sbyte = convert 0I + let v6 : int16 = convert 0I + let v7 : byte = convert 0I + let v8 : uint16 = convert 0I + let v9 : uint32 = convert 0I + let v10 : uint64 = convert 0I + let v11 : float32 = convert 0I + let v12 : decimal = convert 0I + let v13 : Complex = convert 0I diff --git a/tests/fsharp/typecheck/sigs/widen1.fs b/tests/fsharp/typecheck/sigs/widen1.fs new file mode 100644 index 00000000000..08dfc486c3d --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen1.fs @@ -0,0 +1,261 @@ +module App + +type System.SByte with + static member inline widen_to_int16 (a: sbyte) : int16 = int16 a + static member inline widen_to_int32 (a: sbyte) : int32 = int32 a + static member inline widen_to_int64 (a: sbyte) : int64 = int64 a + static member inline widen_to_nativeint (a: sbyte) : nativeint = nativeint a + static member inline widen_to_single (a: sbyte) : single = single a + static member inline widen_to_double (a: sbyte) : double = double a + +type System.Byte with + static member inline widen_to_int16 (a: byte) : int16 = int16 a + static member inline widen_to_uint16 (a: byte) : uint16 = uint16 a + static member inline widen_to_int32 (a: byte) : int32 = int32 a + static member inline widen_to_uint32 (a: byte) : uint32 = uint32 a + static member inline widen_to_int64 (a: byte) : int64 = int64 a + static member inline widen_to_uint64 (a: byte) : uint64 = uint64 a + static member inline widen_to_nativeint (a: byte) : nativeint = nativeint a + static member inline widen_to_unativeint (a: byte) : unativeint = unativeint a + static member inline widen_to_single (a: byte) : single = single a + static member inline widen_to_double (a: byte) : double = double a + +type System.Int16 with + static member inline widen_to_int32 (a: int16) : int32 = int32 a + static member inline widen_to_int64 (a: int16) : int64 = int64 a + static member inline widen_to_nativeint (a: int16) : nativeint = nativeint a + static member inline widen_to_single (a: int16) : single = single a + static member inline widen_to_double (a: int16) : double = double a + +type System.UInt16 with + static member inline widen_to_int32 (a: uint16) : int32 = int32 a + static member inline widen_to_uint32 (a: uint16) : uint32 = uint32 a + static member inline widen_to_int64 (a: uint16) : int64 = int64 a + static member inline widen_to_uint64 (a: uint16) : uint64 = uint64 a + static member inline widen_to_nativeint (a: uint16) : nativeint = nativeint a + static member inline widen_to_unativeint (a: uint16) : unativeint = unativeint a + static member inline widen_to_single (a: uint16) : single = single a + static member inline widen_to_double (a: uint16) : double = double a + +type System.Int32 with + static member inline widen_to_int64 (a: int32) : int64 = int64 a + static member inline widen_to_nativeint (a: int32) : nativeint = nativeint a + static member inline widen_to_single (a: int32) : single = single a + static member inline widen_to_double (a: int32) : double = double a + +type System.UInt32 with + static member inline widen_to_int64 (a: uint32) : int64 = int64 a + static member inline widen_to_uint64 (a: uint32) : uint64 = uint64 a + static member inline widen_to_unativeint (a: uint32) : unativeint = unativeint a + static member inline widen_to_single (a: uint32) : single = single a + static member inline widen_to_double (a: uint32) : double = double a + +type System.Int64 with + static member inline widen_to_double (a: int64) : double = double a + +type System.UInt64 with + static member inline widen_to_double (a: uint64) : double = double a + +type System.IntPtr with + static member inline widen_to_int64 (a: nativeint) : int64 = int64 a + static member inline widen_to_double (a: nativeint) : double = double a + +type System.UIntPtr with + static member inline widen_to_uint64 (a: unativeint) : uint64 = uint64 a + static member inline widen_to_double (a: unativeint) : double = double a + +type System.Single with + static member inline widen_to_double (a: int) : double = double a + +let inline widen_to_byte (x: ^T) : byte = (^T : (static member widen_to_byte : ^T -> byte) (x)) +let inline widen_to_sbyte (x: ^T) : sbyte = (^T : (static member widen_to_sbyte : ^T -> sbyte) (x)) +let inline widen_to_int16 (x: ^T) : int16 = (^T : (static member widen_to_int16 : ^T -> int16) (x)) +let inline widen_to_uint16 (x: ^T) : uint16 = (^T : (static member widen_to_uint16 : ^T -> uint16) (x)) +let inline widen_to_int32 (x: ^T) : int32 = (^T : (static member widen_to_int32 : ^T -> int32) (x)) +let inline widen_to_uint32 (x: ^T) : uint32 = (^T : (static member widen_to_uint32 : ^T -> uint32) (x)) +let inline widen_to_int64 (x: ^T) : int64 = (^T : (static member widen_to_int64 : ^T -> int64) (x)) +let inline widen_to_uint64 (x: ^T) : uint64 = (^T : (static member widen_to_uint64 : ^T -> uint64) (x)) +let inline widen_to_nativeint (x: ^T) : nativeint = (^T : (static member widen_to_nativeint : ^T -> nativeint) (x)) +let inline widen_to_unativeint (x: ^T) : unativeint = (^T : (static member widen_to_unativeint : ^T -> unativeint) (x)) +let inline widen_to_single (x: ^T) : single = (^T : (static member widen_to_single : ^T -> single) (x)) +let inline widen_to_double (x: ^T) : double = (^T : (static member widen_to_double : ^T -> double) (x)) + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + widen_to_byte b + static member inline (+)(a: 'T, b: byte) : byte = widen_to_byte a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + widen_to_sbyte b + static member inline (+)(a: 'T, b: sbyte) : sbyte = widen_to_sbyte a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + widen_to_int16 b + static member inline (+)(a: 'T, b: int16) : int16 = widen_to_int16 a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + widen_to_uint16 b + static member inline (+)(a: 'T, b: uint16) : uint16 = widen_to_uint16 a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + widen_to_int32 b + static member inline (+)(a: 'T, b: int32) : int32 = widen_to_int32 a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + widen_to_uint32 b + static member inline (+)(a: 'T, b: uint32) : uint32 = widen_to_uint32 a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + widen_to_int64 b + static member inline (+)(a: 'T, b: int64) : int64 = widen_to_int64 a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + widen_to_uint64 b + static member inline (+)(a: 'T, b: uint64) : uint64 = widen_to_uint64 a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + widen_to_nativeint b + static member inline (+)(a: 'T, b: nativeint) : nativeint = widen_to_nativeint a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + widen_to_unativeint b + static member inline (+)(a: 'T, b: unativeint) : unativeint = widen_to_unativeint a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + widen_to_single b + static member inline (+)(a: 'T, b: single) : single = widen_to_single a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + widen_to_double b + static member inline (+)(a: 'T, b: double) : double = widen_to_double a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + diff --git a/tests/fsharp/typecheck/sigs/widen2.fs b/tests/fsharp/typecheck/sigs/widen2.fs new file mode 100644 index 00000000000..aa29d401420 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen2.fs @@ -0,0 +1,308 @@ +module App + +type System.SByte with + [] + static member inline widen (a: sbyte) : int16 = int16 a + [] + static member inline widen (a: sbyte) : int32 = int32 a + [] + static member inline widen (a: sbyte) : int64 = int64 a + [] + static member inline widen (a: sbyte) : nativeint = nativeint a + [] + static member inline widen (a: sbyte) : single = single a + [] + static member inline widen (a: sbyte) : double = double a + +type System.Byte with + [] + static member inline widen (a: byte) : int16 = int16 a + [] + static member inline widen (a: byte) : uint16 = uint16 a + [] + static member inline widen (a: byte) : int32 = int32 a + [] + static member inline widen (a: byte) : uint32 = uint32 a + [] + static member inline widen (a: byte) : int64 = int64 a + [] + static member inline widen (a: byte) : uint64 = uint64 a + [] + static member inline widen (a: byte) : nativeint = nativeint a + [] + static member inline widen (a: byte) : unativeint = unativeint a + [] + static member inline widen (a: byte) : single = single a + [] + static member inline widen (a: byte) : double = double a + +type System.Int16 with + [] + static member inline widen (a: int16) : int32 = int32 a + [] + static member inline widen (a: int16) : int64 = int64 a + [] + static member inline widen (a: int16) : nativeint = nativeint a + [] + static member inline widen (a: int16) : single = single a + [] + static member inline widen (a: int16) : double = double a + +type System.UInt16 with + [] + static member inline widen (a: uint16) : int32 = int32 a + [] + static member inline widen (a: uint16) : uint32 = uint32 a + [] + static member inline widen (a: uint16) : int64 = int64 a + [] + static member inline widen (a: uint16) : uint64 = uint64 a + [] + static member inline widen (a: uint16) : nativeint = nativeint a + [] + static member inline widen (a: uint16) : unativeint = unativeint a + [] + static member inline widen (a: uint16) : single = single a + [] + static member inline widen (a: uint16) : double = double a + +type System.Int32 with + [] + static member inline widen (a: int32) : int64 = int64 a + [] + static member inline widen (a: int32) : nativeint = nativeint a + [] + static member inline widen (a: int32) : single = single a + [] + static member inline widen (a: int32) : double = double a + +type System.UInt32 with + static member inline widen (a: uint32) : int64 = int64 a + [] + static member inline widen (a: uint32) : uint64 = uint64 a + [] + static member inline widen (a: uint32) : unativeint = unativeint a + [] + static member inline widen (a: uint32) : single = single a + [] + static member inline widen (a: uint32) : double = double a + +type System.Int64 with + [] + static member inline widen (a: int64) : double = double a + +type System.UInt64 with + [] + static member inline widen (a: uint64) : double = double a + +type System.IntPtr with + [] + static member inline widen (a: nativeint) : int64 = int64 a + [] + static member inline widen (a: nativeint) : double = double a + +type System.UIntPtr with + [] + static member inline widen (a: unativeint) : uint64 = uint64 a + [] + static member inline widen (a: unativeint) : double = double a + +type System.Single with + [] + static member inline widen (a: int) : double = double a + +let inline widen (x: ^T) : ^U = ((^T or ^U) : (static member widen : ^T -> ^U) (x)) + + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + widen b + static member inline (+)(a: 'T, b: byte) : byte = widen a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + widen b + static member inline (+)(a: 'T, b: sbyte) : sbyte = widen a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + widen b + static member inline (+)(a: 'T, b: int16) : int16 = widen a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + widen b + static member inline (+)(a: 'T, b: uint16) : uint16 = widen a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + widen b + static member inline (+)(a: 'T, b: int32) : int32 = widen a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + widen b + static member inline (+)(a: 'T, b: uint32) : uint32 = widen a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + widen b + static member inline (+)(a: 'T, b: int64) : int64 = widen a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + widen b + static member inline (+)(a: 'T, b: uint64) : uint64 = widen a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + widen b + static member inline (+)(a: 'T, b: nativeint) : nativeint = widen a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + widen b + static member inline (+)(a: 'T, b: unativeint) : unativeint = widen a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + widen b + static member inline (+)(a: 'T, b: single) : single = widen a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + widen b + static member inline (+)(a: 'T, b: double) : double = widen a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + +let explicit_widen_calls = + (System.SByte.widen 1y : int16) |> ignore + (System.SByte.widen 1y : int32) |> ignore + (System.SByte.widen 1y : int64) |> ignore + (System.SByte.widen 1y : nativeint) |> ignore + (System.SByte.widen 1y : double) |> ignore + (System.SByte.widen 1y : single) |> ignore + + (System.Int16.widen 1s : int32) |> ignore + (System.Int16.widen 1s : int64) |> ignore + (System.Int16.widen 1s : nativeint) |> ignore + (System.Int16.widen 1s : double) |> ignore + (System.Int16.widen 1s : single) |> ignore diff --git a/tests/fsharp/typecheck/sigs/widen3.fs b/tests/fsharp/typecheck/sigs/widen3.fs new file mode 100644 index 00000000000..4a82e5ffd98 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen3.fs @@ -0,0 +1,261 @@ +module App + +type System.SByte with + member inline a.widen_to_int16 () : int16 = int16 a + member inline a.widen_to_int32 () : int32 = int32 a + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_nativeint () : nativeint = nativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.Byte with + member inline a.widen_to_int16 () : int16 = int16 a + member inline a.widen_to_uint16 () : uint16 = uint16 a + member inline a.widen_to_int32 () : int32 = int32 a + member inline a.widen_to_uint32 () : uint32 = uint32 a + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_uint64 () : uint64 = uint64 a + member inline a.widen_to_nativeint () : nativeint = nativeint a + member inline a.widen_to_unativeint () : unativeint = unativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.Int16 with + member inline a.widen_to_int32 () : int32 = int32 a + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_nativeint () : nativeint = nativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.UInt16 with + member inline a.widen_to_int32 () : int32 = int32 a + member inline a.widen_to_uint32 () : uint32 = uint32 a + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_uint64 () : uint64 = uint64 a + member inline a.widen_to_nativeint () : nativeint = nativeint a + member inline a.widen_to_unativeint () : unativeint = unativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.Int32 with + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_nativeint () : nativeint = nativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.UInt32 with + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_uint64 () : uint64 = uint64 a + member inline a.widen_to_unativeint () : unativeint = unativeint a + member inline a.widen_to_single () : single = single a + member inline a.widen_to_double () : double = double a + +type System.Int64 with + member inline a.widen_to_double () : double = double a + +type System.UInt64 with + member inline a.widen_to_double () : double = double a + +type System.IntPtr with + member inline a.widen_to_int64 () : int64 = int64 a + member inline a.widen_to_double () : double = double a + +type System.UIntPtr with + member inline a.widen_to_uint64 () : uint64 = uint64 a + member inline a.widen_to_double () : double = double a + +type System.Single with + member inline a.widen_to_double () : double = double a + +let inline widen_to_byte (x: ^T) : byte = (^T : (member widen_to_byte : unit -> byte) (x)) +let inline widen_to_sbyte (x: ^T) : sbyte = (^T : (member widen_to_sbyte : unit -> sbyte) (x)) +let inline widen_to_int16 (x: ^T) : int16 = (^T : (member widen_to_int16 : unit -> int16) (x)) +let inline widen_to_uint16 (x: ^T) : uint16 = (^T : (member widen_to_uint16 : unit -> uint16) (x)) +let inline widen_to_int32 (x: ^T) : int32 = (^T : (member widen_to_int32 : unit -> int32) (x)) +let inline widen_to_uint32 (x: ^T) : uint32 = (^T : (member widen_to_uint32 : unit -> uint32) (x)) +let inline widen_to_int64 (x: ^T) : int64 = (^T : (member widen_to_int64 : unit -> int64) (x)) +let inline widen_to_uint64 (x: ^T) : uint64 = (^T : (member widen_to_uint64 : unit -> uint64) (x)) +let inline widen_to_nativeint (x: ^T) : nativeint = (^T : (member widen_to_nativeint : unit -> nativeint) (x)) +let inline widen_to_unativeint (x: ^T) : unativeint = (^T : (member widen_to_unativeint : unit -> unativeint) (x)) +let inline widen_to_single (x: ^T) : single = (^T : (member widen_to_single : unit -> single) (x)) +let inline widen_to_double (x: ^T) : double = (^T : (member widen_to_double : unit -> double) (x)) + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + widen_to_byte b + static member inline (+)(a: 'T, b: byte) : byte = widen_to_byte a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + widen_to_sbyte b + static member inline (+)(a: 'T, b: sbyte) : sbyte = widen_to_sbyte a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + widen_to_int16 b + static member inline (+)(a: 'T, b: int16) : int16 = widen_to_int16 a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + widen_to_uint16 b + static member inline (+)(a: 'T, b: uint16) : uint16 = widen_to_uint16 a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + widen_to_int32 b + static member inline (+)(a: 'T, b: int32) : int32 = widen_to_int32 a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + widen_to_uint32 b + static member inline (+)(a: 'T, b: uint32) : uint32 = widen_to_uint32 a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + widen_to_int64 b + static member inline (+)(a: 'T, b: int64) : int64 = widen_to_int64 a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + widen_to_uint64 b + static member inline (+)(a: 'T, b: uint64) : uint64 = widen_to_uint64 a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + widen_to_nativeint b + static member inline (+)(a: 'T, b: nativeint) : nativeint = widen_to_nativeint a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + widen_to_unativeint b + static member inline (+)(a: 'T, b: unativeint) : unativeint = widen_to_unativeint a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + widen_to_single b + static member inline (+)(a: 'T, b: single) : single = widen_to_single a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + widen_to_double b + static member inline (+)(a: 'T, b: double) : double = widen_to_double a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + diff --git a/tests/fsharp/typecheck/sigs/widen4.fs b/tests/fsharp/typecheck/sigs/widen4.fs new file mode 100644 index 00000000000..1487cabaf2f --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen4.fs @@ -0,0 +1,261 @@ +module App + +type System.SByte with + member inline a.ToInt16 () : int16 = int16 a + member inline a.ToInt32 () : int32 = int32 a + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToIntPtr () : nativeint = nativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.Byte with + member inline a.ToInt16 () : int16 = int16 a + member inline a.ToUInt16 () : uint16 = uint16 a + member inline a.ToInt32 () : int32 = int32 a + member inline a.ToUInt32 () : uint32 = uint32 a + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToUInt64 () : uint64 = uint64 a + member inline a.ToIntPtr () : nativeint = nativeint a + member inline a.ToUIntPtr () : unativeint = unativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.Int16 with + member inline a.ToInt32 () : int32 = int32 a + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToIntPtr () : nativeint = nativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.UInt16 with + member inline a.ToInt32 () : int32 = int32 a + member inline a.ToUInt32 () : uint32 = uint32 a + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToUInt64 () : uint64 = uint64 a + member inline a.ToIntPtr () : nativeint = nativeint a + member inline a.ToUIntPtr () : unativeint = unativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.Int32 with + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToIntPtr () : nativeint = nativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.UInt32 with + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToUInt64 () : uint64 = uint64 a + member inline a.ToUIntPtr () : unativeint = unativeint a + member inline a.ToSingle () : single = single a + member inline a.ToDouble () : double = double a + +type System.Int64 with + member inline a.ToDouble () : double = double a + +type System.UInt64 with + member inline a.ToDouble () : double = double a + +type System.IntPtr with + member inline a.ToInt64 () : int64 = int64 a + member inline a.ToDouble () : double = double a + +type System.UIntPtr with + member inline a.ToUInt64 () : uint64 = uint64 a + member inline a.ToDouble () : double = double a + +type System.Single with + member inline a.ToDouble () : double = double a + +let inline ToByte (x: ^T) : byte = (^T : (member ToByte : unit -> byte) (x)) +let inline ToSbyte (x: ^T) : sbyte = (^T : (member ToSbyte : unit -> sbyte) (x)) +let inline ToInt16 (x: ^T) : int16 = (^T : (member ToInt16 : unit -> int16) (x)) +let inline ToUInt16 (x: ^T) : uint16 = (^T : (member ToUInt16 : unit -> uint16) (x)) +let inline ToInt32 (x: ^T) : int32 = (^T : (member ToInt32 : unit -> int32) (x)) +let inline ToUInt32 (x: ^T) : uint32 = (^T : (member ToUInt32 : unit -> uint32) (x)) +let inline ToInt64 (x: ^T) : int64 = (^T : (member ToInt64 : unit -> int64) (x)) +let inline ToUInt64 (x: ^T) : uint64 = (^T : (member ToUInt64 : unit -> uint64) (x)) +let inline ToIntPtr (x: ^T) : nativeint = (^T : (member ToIntPtr : unit -> nativeint) (x)) +let inline ToUIntPtr (x: ^T) : unativeint = (^T : (member ToUIntPtr : unit -> unativeint) (x)) +let inline ToSingle (x: ^T) : single = (^T : (member ToSingle : unit -> single) (x)) +let inline ToDouble (x: ^T) : double = (^T : (member ToDouble : unit -> double) (x)) + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + ToByte b + static member inline (+)(a: 'T, b: byte) : byte = ToByte a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + ToSbyte b + static member inline (+)(a: 'T, b: sbyte) : sbyte = ToSbyte a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + ToInt16 b + static member inline (+)(a: 'T, b: int16) : int16 = ToInt16 a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + ToUInt16 b + static member inline (+)(a: 'T, b: uint16) : uint16 = ToUInt16 a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + ToInt32 b + static member inline (+)(a: 'T, b: int32) : int32 = ToInt32 a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + ToUInt32 b + static member inline (+)(a: 'T, b: uint32) : uint32 = ToUInt32 a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + ToInt64 b + static member inline (+)(a: 'T, b: int64) : int64 = ToInt64 a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + ToUInt64 b + static member inline (+)(a: 'T, b: uint64) : uint64 = ToUInt64 a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + ToIntPtr b + static member inline (+)(a: 'T, b: nativeint) : nativeint = ToIntPtr a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + ToUIntPtr b + static member inline (+)(a: 'T, b: unativeint) : unativeint = ToUIntPtr a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + ToSingle b + static member inline (+)(a: 'T, b: single) : single = ToSingle a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + ToDouble b + static member inline (+)(a: 'T, b: double) : double = ToDouble a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + diff --git a/tests/fsharp/typecheck/sigs/widen5.fs b/tests/fsharp/typecheck/sigs/widen5.fs new file mode 100644 index 00000000000..92e8a8c648a --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen5.fs @@ -0,0 +1,294 @@ +module App + +type System.SByte with + [] + member a.widen () : int16 = int16 a + [] + member a.widen () : int32 = int32 a + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : nativeint = nativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.Byte with + [] + member a.widen () : int16 = int16 a + [] + member a.widen () : uint16 = uint16 a + [] + member a.widen () : int32 = int32 a + [] + member a.widen () : uint32 = uint32 a + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : uint64 = uint64 a + [] + member a.widen () : nativeint = nativeint a + [] + member a.widen () : unativeint = unativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.Int16 with + [] + member a.widen () : int32 = int32 a + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : nativeint = nativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.UInt16 with + [] + member a.widen () : int32 = int32 a + [] + member a.widen () : uint32 = uint32 a + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : uint64 = uint64 a + [] + member a.widen () : nativeint = nativeint a + [] + member a.widen () : unativeint = unativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.Int32 with + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : nativeint = nativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.UInt32 with + member a.widen () : int64 = int64 a + [] + member a.widen () : uint64 = uint64 a + [] + member a.widen () : unativeint = unativeint a + [] + member a.widen () : single = single a + [] + member a.widen () : double = double a + +type System.Int64 with + [] + member a.widen () : double = double a + +type System.UInt64 with + [] + member a.widen () : double = double a + +type System.IntPtr with + [] + member a.widen () : int64 = int64 a + [] + member a.widen () : double = double a + +type System.UIntPtr with + [] + member a.widen () : uint64 = uint64 a + [] + member a.widen () : double = double a + +type System.Single with + [] + member a.widen () : double = double a + +let inline widen (x: ^T) : ^U = (^T : (member widen : unit -> ^U) (x)) + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + widen b + static member inline (+)(a: 'T, b: byte) : byte = widen a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + widen b + static member inline (+)(a: 'T, b: sbyte) : sbyte = widen a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + widen b + static member inline (+)(a: 'T, b: int16) : int16 = widen a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + widen b + static member inline (+)(a: 'T, b: uint16) : uint16 = widen a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + widen b + static member inline (+)(a: 'T, b: int32) : int32 = widen a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + widen b + static member inline (+)(a: 'T, b: uint32) : uint32 = widen a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + widen b + static member inline (+)(a: 'T, b: int64) : int64 = widen a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + widen b + static member inline (+)(a: 'T, b: uint64) : uint64 = widen a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + widen b + static member inline (+)(a: 'T, b: nativeint) : nativeint = widen a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + widen b + static member inline (+)(a: 'T, b: unativeint) : unativeint = widen a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + widen b + static member inline (+)(a: 'T, b: single) : single = widen a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + widen b + static member inline (+)(a: 'T, b: double) : double = widen a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + diff --git a/tests/fsharp/typecheck/sigs/widen6.fs b/tests/fsharp/typecheck/sigs/widen6.fs new file mode 100644 index 00000000000..9271a91d85c --- /dev/null +++ b/tests/fsharp/typecheck/sigs/widen6.fs @@ -0,0 +1,250 @@ +module App + +type System.SByte with + static member inline op_Implicit (a: sbyte) : int16 = int16 a + static member inline op_Implicit (a: sbyte) : int32 = int32 a + static member inline op_Implicit (a: sbyte) : int64 = int64 a + static member inline op_Implicit (a: sbyte) : nativeint = nativeint a + static member inline op_Implicit (a: sbyte) : single = single a + static member inline op_Implicit (a: sbyte) : double = double a + +type System.Byte with + static member inline op_Implicit (a: byte) : int16 = int16 a + static member inline op_Implicit (a: byte) : uint16 = uint16 a + static member inline op_Implicit (a: byte) : int32 = int32 a + static member inline op_Implicit (a: byte) : uint32 = uint32 a + static member inline op_Implicit (a: byte) : int64 = int64 a + static member inline op_Implicit (a: byte) : uint64 = uint64 a + static member inline op_Implicit (a: byte) : nativeint = nativeint a + static member inline op_Implicit (a: byte) : unativeint = unativeint a + static member inline op_Implicit (a: byte) : single = single a + static member inline op_Implicit (a: byte) : double = double a + +type System.Int16 with + static member inline op_Implicit (a: int16) : int32 = int32 a + static member inline op_Implicit (a: int16) : int64 = int64 a + static member inline op_Implicit (a: int16) : nativeint = nativeint a + static member inline op_Implicit (a: int16) : single = single a + static member inline op_Implicit (a: int16) : double = double a + +type System.UInt16 with + static member inline op_Implicit (a: uint16) : int32 = int32 a + static member inline op_Implicit (a: uint16) : uint32 = uint32 a + static member inline op_Implicit (a: uint16) : int64 = int64 a + static member inline op_Implicit (a: uint16) : uint64 = uint64 a + static member inline op_Implicit (a: uint16) : nativeint = nativeint a + static member inline op_Implicit (a: uint16) : unativeint = unativeint a + static member inline op_Implicit (a: uint16) : single = single a + static member inline op_Implicit (a: uint16) : double = double a + +type System.Int32 with + static member inline op_Implicit (a: int32) : int64 = int64 a + static member inline op_Implicit (a: int32) : nativeint = nativeint a + static member inline op_Implicit (a: int32) : single = single a + static member inline op_Implicit (a: int32) : double = double a + +type System.UInt32 with + static member inline op_Implicit (a: uint32) : int64 = int64 a + static member inline op_Implicit (a: uint32) : uint64 = uint64 a + static member inline op_Implicit (a: uint32) : unativeint = unativeint a + static member inline op_Implicit (a: uint32) : single = single a + static member inline op_Implicit (a: uint32) : double = double a + +type System.Int64 with + static member inline op_Implicit (a: int64) : double = double a + +type System.UInt64 with + static member inline op_Implicit (a: uint64) : double = double a + +type System.IntPtr with + static member inline op_Implicit (a: nativeint) : int64 = int64 a + static member inline op_Implicit (a: nativeint) : double = double a + +type System.UIntPtr with + static member inline op_Implicit (a: unativeint) : uint64 = uint64 a + static member inline op_Implicit (a: unativeint) : double = double a + +type System.Single with + static member inline op_Implicit (a: int) : double = double a + +let inline widen (x: ^T) : ^U = ((^T or ^U) : (static member op_Implicit : ^T -> ^U) (x)) + +type System.Byte with + static member inline (+)(a: byte, b: 'T) : byte = a + widen b + static member inline (+)(a: 'T, b: byte) : byte = widen a + b + +type System.SByte with + static member inline (+)(a: sbyte, b: 'T) : sbyte = a + widen b + static member inline (+)(a: 'T, b: sbyte) : sbyte = widen a + b + +type System.Int16 with + static member inline (+)(a: int16, b: 'T) : int16 = a + widen b + static member inline (+)(a: 'T, b: int16) : int16 = widen a + b + +type System.UInt16 with + static member inline (+)(a: uint16, b: 'T) : uint16 = a + widen b + static member inline (+)(a: 'T, b: uint16) : uint16 = widen a + b + +type System.Int32 with + static member inline (+)(a: int32, b: 'T) : int32 = a + widen b + static member inline (+)(a: 'T, b: int32) : int32 = widen a + b + +type System.UInt32 with + static member inline (+)(a: uint32, b: 'T) : uint32 = a + widen b + static member inline (+)(a: 'T, b: uint32) : uint32 = widen a + b + +type System.Int64 with + static member inline (+)(a: int64, b: 'T) : int64 = a + widen b + static member inline (+)(a: 'T, b: int64) : int64 = widen a + b + +type System.UInt64 with + static member inline (+)(a: uint64, b: 'T) : uint64 = a + widen b + static member inline (+)(a: 'T, b: uint64) : uint64 = widen a + b + +type System.IntPtr with + static member inline (+)(a: nativeint, b: 'T) : nativeint = a + widen b + static member inline (+)(a: 'T, b: nativeint) : nativeint = widen a + b + +type System.UIntPtr with + static member inline (+)(a: unativeint, b: 'T) : unativeint = a + widen b + static member inline (+)(a: 'T, b: unativeint) : unativeint = widen a + b + +type System.Single with + static member inline (+)(a: single, b: 'T) : single = a + widen b + static member inline (+)(a: 'T, b: single) : single = widen a + b + +type System.Double with + static member inline (+)(a: double, b: 'T) : double = a + widen b + static member inline (+)(a: 'T, b: double) : double = widen a + b + +let table = + (1y + 2y) |> ignore + //(1y + 2uy) |> ignore + (1y + 2s) |> ignore + //1y + 2us |> ignore + (1y + 2) |> ignore + //(1y + 2u) |> ignore + (1y + 2L) |> ignore + //1y + 2UL |> ignore + (1y + 2n) |> ignore + //(1y + 2un) |> ignore + (1y + 2.0f) |> ignore + (1y + 2.0) |> ignore + + //(1uy + 2y) |> ignore + (1uy + 2uy) |> ignore + (1uy + 2s) |> ignore + (1uy + 2us) |> ignore + (1uy + 2) |> ignore + (1uy + 2u) |> ignore + (1uy + 2L) |> ignore + (1uy + 2UL) |> ignore + (1uy + 2n) |> ignore + (1uy + 2un) |> ignore + (1uy + 2.0f) |> ignore + (1uy + 2.0) |> ignore + + (1s + 2y) |> ignore + (1s + 2uy) |> ignore + (1s + 2s) |> ignore + //1s + 2us |> ignore + (1s + 2) |> ignore + //(1s + 2u) |> ignore + (1s + 2L) |> ignore + //1s + 2UL |> ignore + (1s + 2n) |> ignore + //(1s + 2un) |> ignore + (1s + 2.0f) |> ignore + (1s + 2.0) |> ignore + + //(1us + 2y) |> ignore + (1us + 2uy) |> ignore + //(1us + 2s) |> ignore + (1us + 2us) |> ignore + (1us + 2) |> ignore + (1us + 2u) |> ignore + (1us + 2L) |> ignore + (1us + 2UL) |> ignore + (1us + 2n) |> ignore + (1us + 2un) |> ignore + (1us + 2.0f) |> ignore + (1us + 2.0) |> ignore + + (1 + 2y) |> ignore + (1 + 2uy) |> ignore + (1 + 2s) |> ignore + 1 + 2us |> ignore + (1 + 2) |> ignore + //(1 + 2u) |> ignore + (1 + 2L) |> ignore + //1 + 2UL |> ignore + (1 + 2n) |> ignore + //(1 + 2un) |> ignore + (1 + 2.0f) |> ignore + (1 + 2.0) |> ignore + + //(1u + 2y) |> ignore + (1u + 2uy) |> ignore + //(1us + 2s) |> ignore + (1u + 2us) |> ignore + //(1u + 2) |> ignore + (1u + 2u) |> ignore + (1u + 2L) |> ignore + (1u + 2UL) |> ignore + //(1u + 2n) |> ignore + (1u + 2un) |> ignore + (1u + 2.0f) |> ignore + (1u + 2.0) |> ignore + + (1L + 2y) |> ignore + (1L + 2uy) |> ignore + (1L + 2s) |> ignore + (1L + 2us) |> ignore + (1L + 2) |> ignore + //(1L + 2u) // gives error + (1L + 2L) |> ignore + //1L + 2UL // gives error + (1L + 2n) |> ignore + //(1L + 2un) // gives error + //(1L + 2.0f) // gives error + (1L + 2.0) |> ignore + + //(1u + 2y) // gives error + (1UL + 2uy) |> ignore + //(1us + 2s) // gives error + (1UL + 2us) |> ignore + //(1u + 2) // gives error + (1UL + 2u) |> ignore + //(1UL + 2L) // gives error + (1UL + 2UL) |> ignore + //(1u + 2n) // gives error + (1UL + 2un) |> ignore + //(1UL + 2.0f) // gives error + (1UL + 2.0) |> ignore + + (1n + 2y) |> ignore + (1n + 2uy) |> ignore + (1n + 2s) |> ignore + (1n + 2us) |> ignore + (1n + 2) |> ignore + //(1n + 2u) // gives error + (1n + 2L) |> ignore + //1n + 2UL // gives error + (1n + 2n) |> ignore + //(1n + 2un) // gives error + //(1n + 2.0f) // gives error + (1n + 2.0) |> ignore + + //(1un + 2y) // gives error + (1un + 2uy) |> ignore + //(1un + 2s) // gives error + (1un + 2us) |> ignore + //(1un + 2) // gives error + (1un + 2u) |> ignore + //(1un + 2L) // gives error + (1un + 2UL) |> ignore + //(1un + 2n) // gives error + (1un + 2un) |> ignore + //(1un + 2.0f) // gives error + (1un + 2.0) |> ignore + diff --git a/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02.fsx b/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02.fsx index f211712534b..050c4070cc6 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02.fsx +++ b/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02.fsx @@ -16,13 +16,13 @@ let f4 x = (x : decimal) + "" exit 1 -//The type 'int' does not match the type 'string' -//The type 'int' does not match the type 'string' -//The type 'byte' does not match the type 'string' -//The type 'byte' does not match the type 'string' -//The type 'int' does not match the type 'float' -//The type 'int' does not match the type 'float' -//The type 'decimal' does not match the type 'float32' -//The type 'decimal' does not match the type 'float32' -//The type 'string' does not match the type 'decimal' -//The type 'string' does not match the type 'decimal' +//The types 'string, int' do not support the operator +//The types 'string, int' do not support the operator +//The types 'string, byte' do not support the operator +//The types 'string, byte' do not support the operator +//The types 'float, int' do not support the operator +//The types 'float, int' do not support the operator +//The types 'float32, decimal' do not support the operator +//The types 'float32, decimal' do not support the operator +//The types 'decimal, string' do not support the operator +//The types 'decimal, string' do not support the operator diff --git a/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02_5_0.fsx b/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02_5_0.fsx index ad279dbc4de..f211712534b 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02_5_0.fsx +++ b/tests/fsharpqa/Source/Conformance/Expressions/Type-relatedExpressions/E_RigidTypeAnnotation02_5_0.fsx @@ -20,7 +20,6 @@ exit 1 //The type 'int' does not match the type 'string' //The type 'byte' does not match the type 'string' //The type 'byte' does not match the type 'string' -//This expression was expected to have type. 'float' .but here has type. 'int' //The type 'int' does not match the type 'float' //The type 'int' does not match the type 'float' //The type 'decimal' does not match the type 'float32' diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionOperator01.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionOperator01.fs index e038022643b..f9200a8b2f8 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionOperator01.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/TypeExtensions/basic/E_ExtensionOperator01.fs @@ -1,26 +1,26 @@ // #Regression #Conformance #ObjectOrientedTypes #TypeExtensions // Regression for FSHARP1.0:3592 -// Can't use extension methods to define operators -//Extension members cannot provide operator overloads\. Consider defining the operator as part of the type definition instead\. -//Extension members cannot provide operator overloads\. Consider defining the operator as part of the type definition instead\. +// //The type 'Exception' does not support the operator '\+'$ //The type 'Exception' does not support the operator '\+'$ //The type 'MyType' does not support the operator '\+'$ //The type 'MyType' does not support the operator '\+'$ + + open System type MyType() = member this.X = 1 -module TestExtensions = - type MyType with - static member (+) (e1: MyType, e2: MyType) = - new MyType() - type System.Exception with - static member (+) (e1: Exception, e2: Exception) = - new Exception(e1.Message + " " + e2.Message) + + + + + + + let e1 = Exception() let e2 = Exception() diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ConstraintCall1.fs b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ConstraintCall1.fs index 6686176a6b0..78855047688 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ConstraintCall1.fs +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ConstraintCall1.fs @@ -1,4 +1,4 @@ // #Conformance #ConstraintCall -//None of the types 'int, bool, string' support the operator 'M' +//The types 'int, bool, string' do not support the operator 'M' let inline h (x, y, z) = ((^a or ^b or ^c) : (static member M : ^a * ^b * ^c -> ^d) (x,y,z)) let _ : int = h (1,false,"") diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ExplicitMemberConstraints2.fs b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ExplicitMemberConstraints2.fs index 70699d463f2..e0ea03b1a4f 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ExplicitMemberConstraints2.fs +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_ExplicitMemberConstraints2.fs @@ -1,5 +1,5 @@ // #Conformance #TypeConstraints -//None of the types 'bool, int, string' support the operator 'get_M' +//The types 'bool, int, string' do not support the operator 'get_M' let inline g< ^t, ^u, ^v when (^t or ^u or ^v) : (static member M : string)>() = 0 diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_MemberConstraint02.fs b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_MemberConstraint02.fs index 023f7c8a06a..6d2edd7c4fb 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_MemberConstraint02.fs +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_MemberConstraint02.fs @@ -1,5 +1,5 @@ // #Conformance #TypeConstraints #Diagnostics -//The type 'Foo' has a method 'someFunc' \(full name 'someFunc'\), but the method is not static$ +//someFunc is not a static method$ let inline testFunc (a : ^x) = (^x : (static member someFunc : unit -> ^x) ()) diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_Regression02.fs b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_Regression02.fs deleted file mode 100644 index deb1f392352..00000000000 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/E_Regression02.fs +++ /dev/null @@ -1,315 +0,0 @@ -// #Regression #Conformance #TypeConstraints -// Regression test for CTP bug reported at http://cs.hubfs.net/forums/thread/9313.aspx -// In CTP, this was a stack overflow in the compiler. Now we give 64 errors -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P1' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P2' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P3' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P4' is not defined -//The type 'uint32' does not match the type 'int32' -//The value or constructor 'P4' is not defined -module SmartHashUtils = - let ByteToUInt (array:byte[]) offset length endian = - - let temp:uint32[] = Array.create (length / 4) (uint32 0) - let ff = uint32 0xff - - match endian with - | 0 -> - let funn i n = - (uint32 array.[offset + i*4] &&& ff) ||| - ((uint32 array.[offset + i*4+1] &&& ff) <<< 8) ||| - ((uint32 array.[offset + i*4+2] &&& ff) <<< 16) ||| - ((uint32 array.[offset + i*4+3] &&& ff) <<< 24) - Array.mapi funn temp - | _ -> - let funn i n = - ((uint32 array.[offset + i*4] &&& ff) <<< 24) ||| - ((uint32 array.[offset + i*4+1] &&& ff) <<< 16) ||| - ((uint32 array.[offset + i*4+2] &&& ff) <<< 8) ||| - (uint32 array.[offset + i*4+3] &&& ff) - Array.mapi funn temp - - - let UIntToByte (array:uint32[]) offset length endian = - let temp:byte[] = Array.create (length * 4) (byte 0) - - match endian with - | 0 -> - let funn i n = byte (array.[offset + i/4] >>> (i%4 * 8)) - Array.mapi funn temp - | _ -> - let funn i n = byte (array.[offset + i/4] >>> ((3 - i%4) * 8)) - Array.mapi funn temp - - - let ULongToByte (array:uint64[]) offset length endian = - let temp:byte[] = Array.create (length * 8) (byte 0) - - match endian with - | 0 -> - let funn i n = byte (array.[offset + i/8] >>> (i%8 * 8)) - Array.mapi funn temp - | _ -> - let funn i n = byte (array.[offset + i/8] >>> ((7 - i%8) * 8)) - Array.mapi funn temp - - - let LS (x:uint32) n = uint32 ((x <<< n) ||| (x >>> (32 - n))) - let RS (x:uint32) n = uint32 ((x >>> n) ||| (x <<< (32 - n))) - -module SmartHashBlock = - open System.Security.Cryptography - - [] - type BlockHashAlgorithm() = - inherit HashAlgorithm() - ///The size in bytes of an individual block. - let mutable blockSize = 1 - ///The length of bytes, that have been processed. - ///This number includes the number of bytes currently waiting in the buffer. - let mutable count:uint64 = uint64 0 - ///Buffer for storing leftover bytes that are waiting to be processed. - let mutable buffer = Array.zeroCreate blockSize - ///The number of bytes currently in the Buffer waiting to be processed. - let mutable bufferCount = 0 - - member b.BlockSize with get() = blockSize and set(v) = blockSize <- v - member b.BufferCount with get() = bufferCount and set(v) = bufferCount <- v - member b.Count with get() = count and set(v) = count <- v - - default x.Initialize() = - count <- uint64 0 - bufferCount <- 0 - buffer <- Array.zeroCreate blockSize - - default x.HashCore(array, ibStart, cbSize) = - //let engineUpdate input offset' length' = - let mutable offset = ibStart - let mutable length = cbSize - count <- count + (uint64 length) - - if ((bufferCount > 0) && ((bufferCount + length) >= blockSize)) then - let off = blockSize - bufferCount - Array.blit array offset buffer bufferCount off - offset <- offset + off - length <- length - off - bufferCount <- 0 - x.BlockTransform (buffer, 0) - - let numBlocks = length / blockSize - for i in 0..(numBlocks-1) do - x.BlockTransform (array, (offset + i * blockSize)) - - let bytesLeft = length % blockSize - - if (bytesLeft <> 0) then - Array.blit array (offset + (length - bytesLeft)) buffer bufferCount bytesLeft - bufferCount <- bufferCount + bytesLeft - - abstract BlockTransform: (byte[] * int) -> unit - - member x.CreatePadding(minSize, append) = - let mutable paddingSize = x.BlockSize - ((int x.Count) % x.BlockSize) - - if (paddingSize < minSize) then paddingSize <- paddingSize + x.BlockSize - - let Padding = Array.create paddingSize (byte 0) - Padding.[0] <- append - Padding - -module SmartHashMD5 = - open SmartHashUtils - open SmartHashBlock - - - type MD5() as this = - inherit BlockHashAlgorithm() - ///The size in bytes of an individual block. - let mutable state:int32[] = null - - do this.BlockSize <- 64 - do this.HashSizeValue <- 128 - do state <- Array.zeroCreate 4 - do this.Initialize() - - override x.Initialize() = - base.Initialize() - state.[0] <- 0x67452301 - state.[1] <- 0xEFCDAB89 - state.[2] <- 0x98BADCFE - state.[3] <- 0x10325476 - - member x.BlockTransform(data, iOffset) = - let mutable A = state.[0] - let mutable B = state.[3] - let mutable C = state.[2] - let mutable D = state.[1] - - let X = ByteToUInt data iOffset 64 0 - - A <- D + LS (P1 D C B + A + X.[0] + uint32 0xD76AA478) 7 - B <- A + LS(P1 A D C + B + X.[1] + uint32 0xE8C7B756) 12 - C <- B + LS(P1 B A D + C + X.[2] + uint32 0x242070DB) 17 - D <- C + LS(P1 C B A + D + X.[3] + uint32 0xC1BDCEEE) 22 - A <- D + LS(P1 D C B + A + X.[4] + uint32 0xF57C0FAF) 7 - B <- A + LS(P1 A D C + B + X.[5] + uint32 0x4787C62A) 12 - C <- B + LS(P1 B A D + C + X.[6] + uint32 0xA8304613) 17 - D <- C + LS(P1 C B A + D + X.[7] + uint32 0xFD469501) 22 - A <- D + LS(P1 D C B + A + X.[8] + uint32 0x698098D8) 7 - B <- A + LS(P1 A D C + B + X.[9] + uint32 0x8B44F7AF) 12 - C <- B + LS(P1 B A D + C + X.[10] + uint32 0xFFFF5BB1) 17 - D <- C + LS(P1 C B A + D + X.[11] + uint32 0x895CD7BE) 22 - A <- D + LS(P1 D C B + A + X.[12] + uint32 0x6B901122) 7 - B <- A + LS(P1 A D C + B + X.[13] + uint32 0xFD987193) 12 - C <- B + LS(P1 B A D + C + X.[14] + uint32 0xA679438E) 17 - D <- C + LS(P1 C B A + D + X.[15] + uint32 0x49B40821) 22 - - A <- D + LS(P2 D C B + A + X.[1] + uint32 0xF61E2562) 5 - B <- A + LS(P2 A D C + B + X.[6] + uint32 0xC040B340) 9 - C <- B + LS(P2 B A D + C + X.[11] + uint32 0x265E5A51) 14 - D <- C + LS(P2 C B A + D + X.[0] + uint32 0xE9B6C7AA) 20 - A <- D + LS(P2 D C B + A + X.[5] + uint32 0xD62F105D) 5 - B <- A + LS(P2 A D C + B + X.[10] + uint32 0x02441453) 9 - C <- B + LS(P2 B A D + C + X.[15] + uint32 0xD8A1E681) 14 - D <- C + LS(P2 C B A + D + X.[4] + uint32 0xE7D3FBC8) 20 - A <- D + LS(P2 D C B + A + X.[9] + uint32 0x21E1CDE6) 5 - B <- A + LS(P2 A D C + B + X.[14] + uint32 0xC33707D6) 9 - C <- B + LS(P2 B A D + C + X.[3] + uint32 0xF4D50D87) 14 - D <- C + LS(P2 C B A + D + X.[8] + uint32 0x455A14ED) 20 - A <- D + LS(P2 D C B + A + X.[13] + uint32 0xA9E3E905) 5 - B <- A + LS(P2 A D C + B + X.[2] + uint32 0xFCEFA3F8) 9 - C <- B + LS(P2 B A D + C + X.[7] + uint32 0x676F02D9) 14 - D <- C + LS(P2 C B A + D + X.[12] + uint32 0x8D2A4C8A) 20 - - A <- D + LS(P3 D C B + A + X.[5] + uint32 0xFFFA3942) 4 - B <- A + LS(P3 A D C + B + X.[8] + uint32 0x8771F681) 11 - C <- B + LS(P3 B A D + C + X.[11] + uint32 0x6D9D6122) 16 - D <- C + LS(P3 C B A + D + X.[14] + uint32 0xFDE5380C) 23 - A <- D + LS(P3 D C B + A + X.[1] + uint32 0xA4BEEA44) 4 - B <- A + LS(P3 A D C + B + X.[4] + uint32 0x4BDECFA9) 11 - C <- B + LS(P3 B A D + C + X.[7] + uint32 0xF6BB4B60) 16 - D <- C + LS(P3 C B A + D + X.[10] + uint32 0xBEBFBC70) 23 - A <- D + LS(P3 D C B + A + X.[13] + uint32 0x289B7EC6) 4 - B <- A + LS(P3 A D C + B + X.[0] + uint32 0xEAA127FA) 11 - C <- B + LS(P3 B A D + C + X.[3] + uint32 0xD4EF3085) 16 - D <- C + LS(P3 C B A + D + X.[6] + uint32 0x04881D05) 23 - A <- D + LS(P3 D C B + A + X.[9] + uint32 0xD9D4D039) 4 - B <- A + LS(P3 A D C + B + X.[12] + uint32 0xE6DB99E5) 11 - C <- B + LS(P3 B A D + C + X.[15] + uint32 0x1FA27CF8) 16 - D <- C + LS(P3 C B A + D + X.[2] + uint32 0xC4AC5665) 23 - - A <- D + LS(P4 D C B + A + X.[0] + uint32 0xF4292244) 6 - B <- A + LS(P4 A D C + B + X.[7] + uint32 0x432AFF97) 10 - C <- B + LS(P4 B A D + C + X.[14] + uint32 0xAB9423A7) 15 - D <- C + LS(P4 C B A + D + X.[5] + uint32 0xFC93A039) 21 - A <- D + LS(P4 D C B + A + X.[12] + uint32 0x655B59C3) 6 - B <- A + LS(P4 A D C + B + X.[3] + uint32 0x8F0CCC92) 10 - C <- B + LS(P4 B A D + C + X.[10] + uint32 0xFFEFF47D) 15 - D <- C + LS(P4 C B A + D + X.[1] + uint32 0x85845DD1) 21 - A <- D + LS(P4 D C B + A + X.[8] + uint32 0x6FA87E4F) 6 - B <- A + LS(P4 A D C + B + X.[15] + uint32 0xFE2CE6E0) 10 - C <- B + LS(P4 B A D + C + X.[6] + uint32 0xA3014314) 15 - D <- C + LS(P4 C B A + D + X.[13] + uint32 0x4E0811A1) 21 - A <- D + LS(P4 D C B + A + X.[4] + uint32 0xF7537E82) 6 - B <- A + LS(P4 A D C + B + X.[11] + uint32 0xBD3AF235) 10 - C <- B + LS(P4 B A D + C + X.[2] + uint32 0x2AD7D2BB) 15 - D <- C + LS(P4 C B A + D + X.[9] + uint32 0xEB86D391) 21 - - state.[0] <- state.[0] + A - state.[3] <- state.[3] + B - state.[2] <- state.[2] + C - state.[1] <- state.[1] + D diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/env.lst b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/env.lst index cb015071109..4b5d6f429f8 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/env.lst +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/env.lst @@ -9,7 +9,6 @@ NoMT SOURCE=ByRef04.fsx FSIMODE=PIPE COMPILE_ONLY=1 # ByRef04.fsx SOURCE=Regressions01.fs # Regressions01.fs SOURCE=E_Regressions01.fs SCFLAGS="--test:ErrorRanges" # E_Regressions01.fs - SOURCE=E_Regression02.fs # E_Regression02.fs SOURCE=DefaultConstructorConstraint01.fs SCFLAGS="--test:ErrorRanges" # DefaultConstructorConstraint01.fs SOURCE=DefaultConstructorConstraint02.fs SCFLAGS="--langversion:5.0 --test:ErrorRanges" # DefaultConstructorConstraint02.fs SOURCE=DefaultConstructorConstraint03.fs SCFLAGS="--test:ErrorRanges" # DefaultConstructorConstraint03.fs diff --git a/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs b/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs index fbe1aab5902..e06477bf638 100644 --- a/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs +++ b/tests/fsharpqa/Source/Diagnostics/General/E_NullableOperators01.fs @@ -25,7 +25,7 @@ let _ = iq ? iq -//None of the types 'System\.Nullable, int' support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ +//The types 'System\.Nullable, int' do not support the operator '\?>='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?>'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<='\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ //The type 'System\.Nullable' does not support the operator '\?<'\. Consider opening the module 'Microsoft\.FSharp\.Linq\.NullableOperators'\.$ diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 49117c04cea..e07ba43a35c 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -340,10 +340,10 @@ match box 1 with dumpDiagnostics checkResults |> shouldEqual [ "(5,34--5,35): The type 'obj' does not support the operator '+'" "(5,32--5,33): The type 'obj' does not support the operator '+'" - "(7,45--7,46): The type 'obj' does not match the type 'uint64'" - "(7,43--7,44): The type 'obj' does not match the type 'uint64'" - "(8,43--8,44): The type 'obj' does not match the type 'int8'" - "(8,41--8,42): The type 'obj' does not match the type 'int8'" + "(7,45--7,46): The types 'uint64, obj' do not support the operator '+'"; + "(7,43--7,44): The types 'uint64, obj' do not support the operator '+'"; + "(8,43--8,44): The types 'int8, obj' do not support the operator '+'"; + "(8,41--8,42): The types 'int8, obj' do not support the operator '+'"; "(3,6--3,11): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." ] @@ -1075,7 +1075,7 @@ Some "" |> eq "(19,2--19,4): This expression was expected to have type 'obj' but here has type 'int'" "(21,2--21,7): This expression was expected to have type 'obj' but here has type 'bool'" "(23,2--23,6): This expression was expected to have type 'obj' but here has type 'bool'" - "(28,28--28,29): The type 'obj' does not match the type 'int'" + "(28,28--28,29): The types 'int, obj' do not support the operator '+'" "(41,5--41,6): The value or constructor 'm' is not defined." "(42,5--42,6): The value or constructor 'n' is not defined." "(43,5--43,6): The value or constructor 'o' is not defined." diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs index a4e614c48e0..97433188e44 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs @@ -1120,8 +1120,7 @@ type UsingMSBuild() as this = MoveCursorToEndOfMarker(file2,"#load @\"Fi") let ans = GetSquiggleAtCursor(file2) - AssertSquiggleIsErrorContaining(ans, "'string'") - AssertSquiggleIsErrorContaining(ans, "'int'") + AssertSquiggleIsErrorContaining(ans, "'int, string'") AssertSquiggleIsErrorNotContaining(ans, "foo") // In this bug the .fsx project directory was wrong so it couldn't reference a relative file.