diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index cf1b9bce32a..f182c98ac85 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4076,7 +4076,8 @@ 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(tys=objTys; memberName=".ctor"; memberFlags=memberFlags; objAndArgTys=argTys; returnTyOpt=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 @@ -4125,7 +4126,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let item = Item.OtherName (Some id, memberConstraintTy, None, 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, ref None), tpenv | _ -> error(Error(FSComp.SR.tcInvalidConstraint(), m)) @@ -8813,7 +8814,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, ref None, sln) let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) let expr = mkLambdas g mItem [] vs (expr, retTy) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 6bc57f606ca..c30ca0cdc66 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1394,7 +1394,7 @@ 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, source, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else @@ -1411,8 +1411,8 @@ 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 retTy = GetFSharpViewOfReturnType g retTy + let traitInfo = traitInfo.WithSupportTypes supportTys + let retTy = GetFSharpViewOfReturnType g retTy // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then @@ -1754,8 +1754,17 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) | _ -> - if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) - else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) + match supportTys, source.Value with + | [_], Some s when s.StartsWith("Operators.") -> + let opSource = s[10..] + if opSource = nm then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + else FSComp.SR.csTypeDoesNotSupportOperator(tyString, opSource) + | [_], Some s -> + FSComp.SR.csFunctionDoesNotSupportType(s, tyString, nm) + | [_], _ + -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + | _, _ + -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) return! ErrorD(ConstraintSolverError(err, m, m2)) | _ -> @@ -1928,7 +1937,6 @@ and TransactMemberConstraintSolution traitInfo (trace: OptionalTrace) sln = /// 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 results = if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m @@ -1938,7 +1946,7 @@ and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolutio let minfos = [ for (supportTy, nominalTy) in nominalTys do let infos = - match memFlags.MemberKind with + match traitInfo.MemberFlags.MemberKind with | SynMemberKind.Constructor -> GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m nominalTy | _ -> @@ -1962,8 +1970,7 @@ 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 traitInfo2 = traitInfo.WithMemberName "op_Implicit" results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" traitInfo2 else results @@ -2020,7 +2027,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(tys=supportTys; objAndArgTys=argTys; returnTyOpt=retTy)) = traitInfo freeInTypesLeftToRightSkippingConstraints csenv.g (supportTys @ argTys @ Option.toList retTy) and MemberConstraintIsReadyForWeakResolution csenv traitInfo = @@ -2104,8 +2111,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(tys=tys1; memberName=nm1; memberFlags=memFlags1; objAndArgTys=argTys1)) = traitInfo1 + let (TTrait(tys=tys2; memberName=nm2; memberFlags=memFlags2; objAndArgTys=argTys2)) = traitInfo2 memFlags1.IsInstance = memFlags2.IsInstance && nm1 = nm2 && // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. @@ -2130,8 +2137,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(tys=tys1; objAndArgTys=argTys1; returnTyOpt=rty1)) = traitInfo1 + let (TTrait(tys=tys2; objAndArgTys=argTys2; returnTyOpt=rty2)) = traitInfo2 if retry then match tys1, tys2 with | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index cfc34649ae5..10eb7ab672c 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -167,7 +167,7 @@ and accOp cenv env (op, tyargs, args, m) = | _ -> () /// Walk a trait call, collecting type variables -and accTraitInfo cenv env (mFallback : range) (TTrait(tys, _nm, _, argTys, retTy, _sln)) = +and accTraitInfo cenv env (mFallback : range) (TTrait(tys=tys; objAndArgTys=argTys; returnTyOpt=retTy)) = argTys |> accTypeInst cenv env mFallback retTy |> Option.iter (accTy cenv env mFallback) tys |> List.iter (accTy cenv env mFallback) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index dfb5a8f20a1..985d3fbe22b 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -823,7 +823,7 @@ module PrintTypes = and layoutTraitWithInfo denv env traitInfo = let g = denv.g - let (TTrait(tys, _, memFlags, _, _, _)) = traitInfo + let (TTrait(tys=tys;memberFlags=memFlags)) = traitInfo let nm = traitInfo.MemberDisplayNameCore let nameL = ConvertValLogicalNameToDisplayLayout false (tagMember >> wordL) nm if denv.shortConstraints then diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index c60fb146d54..e9dee56e748 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -346,7 +346,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(solution=soln), _) -> match visitTraitSolutionOpt, soln.Value with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () @@ -432,11 +432,11 @@ and CheckTypeConstraintDeep cenv f g env x = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> () -and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env (TTrait(tys, _, _, argTys, retTy, soln)) = - CheckTypesDeep cenv f g env tys - CheckTypesDeep cenv f g env argTys - Option.iter (CheckTypeDeep cenv f g env true ) retTy - match visitTraitSolutionOpt, soln.Value with +and CheckTraitInfoDeep cenv (_, _, _, visitTraitSolutionOpt, _ as f) g env traitInfo = + CheckTypesDeep cenv f g env traitInfo.SupportTypes + CheckTypesDeep cenv f g env traitInfo.CompiledObjectAndArgumentTypes + Option.iter (CheckTypeDeep cenv f g env true ) traitInfo.CompiledReturnType + match visitTraitSolutionOpt, traitInfo.Solution with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index e828863c3a8..d8d9ccd9866 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -377,6 +377,26 @@ let IsExe fileName = let ext = Path.GetExtension fileName String.Compare(ext, ".exe", StringComparison.OrdinalIgnoreCase) = 0 +let addConstraintSources(ia: ImportedAssembly) = + let contents = ia.FSharpViewOfMetadata.Contents + let addCxsToMember name (v: Val) = + for typar in fst v.GeneralizedType do + for cx in typar.Constraints do + match cx with + | TyparConstraint.MayResolveMember(TTrait(source=source), _) -> + source.Value <- Some name + | _ -> () + let rec addCxsToModule name (m: ModuleOrNamespaceType) = + for e in m.ModuleAndNamespaceDefinitions do + if e.IsModuleOrNamespace then + let mname = + if String.length name > 0 then name + "." + e.DisplayName + elif e.IsModule then e.DisplayName + else "" + addCxsToModule mname e.ModuleOrNamespaceType + for memb in m.AllValsAndMembers do addCxsToMember (name + "." + memb.LogicalName) memb + addCxsToModule "" contents.ModuleOrNamespaceType + type TcConfig with member tcConfig.TryResolveLibWithDirectories(r: AssemblyReference) = @@ -2233,6 +2253,9 @@ and [] TcImports let _dllinfos, phase2s = results |> Array.choose id |> List.ofArray |> List.unzip fixupOrphanCcus () let ccuinfos = List.collect (fun phase2 -> phase2 ()) phase2s + if importsBase.IsSome then + importsBase.Value.CcuTable.Values |> Seq.iter addConstraintSources + ccuTable.Values |> Seq.iter addConstraintSources return ccuinfos } diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 46fd02464da..b17d5877ad9 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -315,6 +315,7 @@ csExpectTypeWithOperatorButGivenFunction,"Expecting a type supporting the operat csExpectTypeWithOperatorButGivenTuple,"Expecting a type supporting the operator '%s' but given a tuple type" csTypesDoNotSupportOperator,"None of the types '%s' support the operator '%s'" csTypeDoesNotSupportOperator,"The type '%s' does not support the operator '%s'" +csFunctionDoesNotSupportType,"'%s' does not support the type '%s', because the latter lacks the required (real or built-in) member '%s'" csTypesDoNotSupportOperatorNullable,"None of the types '%s' 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'" diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 3aa8f1cbe5e..4d0b994f35b 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -899,12 +899,12 @@ 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)), _, _ -> - let tysR = ConvTypes cenv tys + | TOp.TraitCall traitInfo, _, _ -> + let tysR = ConvTypes cenv traitInfo.SupportTypes let tyargsR = ConvTypes cenv tyargs - let argTysR = ConvTypes cenv argTys + let argTysR = ConvTypes cenv traitInfo.CompiledObjectAndArgumentTypes let argsR = ConvExprs cenv env args - E.TraitCall(tysR, nm, memFlags, argTysR, tyargsR, argsR) + E.TraitCall(tysR, traitInfo.MemberLogicalName, traitInfo.MemberFlags, argTysR, tyargsR, argsR) | TOp.RefAddrGet readonly, [ty], [e] -> let replExpr = mkRecdFieldGetAddrViaExprAddr(readonly, e, mkRefCellContentsRef g, [ty], m) diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 5caf1bc1245..6319af1089c 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -1460,18 +1460,18 @@ type FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = (fun () -> Item.Trait(info)), (fun _ _ _ad -> true)) - let (TTrait(tys, nm, flags, atys, retTy, _)) = info member _.MemberSources = - tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + info.SupportTypes |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection - member _.MemberName = nm + member _.MemberName = info.MemberLogicalName - member _.MemberIsStatic = not flags.IsInstance + member _.MemberIsStatic = not info.MemberFlags.IsInstance - member _.MemberArgumentTypes = atys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + member _.MemberArgumentTypes = + info.CompiledObjectAndArgumentTypes |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection member _.MemberReturnType = - match retTy with + match info.CompiledReturnType with | None -> FSharpType(cenv, cenv.g.unit_ty) | Some ty -> FSharpType(cenv, ty) override x.ToString() = "" diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index a0665d32212..2109361291e 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2454,29 +2454,41 @@ type TraitWitnessInfo = 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 * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * solution: TraitConstraintSln option ref + /// to store the inferred solution of the constraint. And a mutable source cell to store + /// the name of the type or member that defined the constraint. + | TTrait of + tys: TTypes * + memberName: string * + memberFlags: SynMemberFlags * + objAndArgTys: TTypes * + returnTyOpt: TType option * + source: string option ref * + solution: TraitConstraintSln option ref /// 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 = tys)) = x in tys) /// Get the logical member name associated with the member constraint. - member x.MemberLogicalName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) + member x.MemberLogicalName = (let (TTrait(memberName = nm)) = x in nm) /// Get the member flags associated with the member constraint. - member x.MemberFlags = (let (TTrait(_, _, flags, _, _, _)) = x in flags) - - 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.MemberFlags = (let (TTrait(memberFlags = flags)) = x in flags) + member x.CompiledObjectAndArgumentTypes = (let (TTrait(objAndArgTys = objAndArgTys)) = x in objAndArgTys) + /// Get the optional return type recorded in the member constraint. - member x.CompiledReturnType = (let (TTrait(_, _, _, _, retTy, _)) = x in retTy) - + member x.CompiledReturnType = (let (TTrait(returnTyOpt = 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(solution = sln)) = x in sln.Value) + and set v = (let (TTrait(solution = sln)) = x in sln.Value <- v) + + 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)) + + member x.WithSupportTypes(tys) = (let (TTrait(_, b, c, d, e, f, g)) = x in TTrait(tys, b, c, d, e, f, g)) + + member x.WithMemberName(name) = (let (TTrait(a, _, c, d, e, f, g)) = x in TTrait(a, name, c, d, e, f, g)) [] member x.DebugText = x.ToString() diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 61674b35fa1..3eb47b5eb47 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1678,13 +1678,15 @@ type TraitWitnessInfo = type TraitConstraintInfo = /// Indicates the signature of a member constraint. Contains a mutable solution cell - /// to store the inferred solution of the constraint. + /// to store the inferred solution of the constraint. And a mutable source cell to store + /// the name of the type or member that defined the constraint. | TTrait of tys: TTypes * memberName: string * memberFlags: Syntax.SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * + source: string option ref * solution: TraitConstraintSln option ref override ToString: unit -> string @@ -1719,6 +1721,10 @@ type TraitConstraintInfo = /// the extension property MemberDisplayNameCore member WithMemberKind: SynMemberKind -> TraitConstraintInfo + member WithSupportTypes: TTypes -> TraitConstraintInfo + + member WithMemberName: string -> TraitConstraintInfo + /// Represents the solution of a member constraint during inference. [] type TraitConstraintSln = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 519a076a41e..8616a7e43fa 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -262,7 +262,7 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> Some x) -and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = +and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, source, slnCell)) = let slnCell = match slnCell.Value with | None -> None @@ -298,7 +298,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, source, newSlnCell) and bindTypars tps tyargs tpinst = match tps with @@ -961,8 +961,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 && @@ -2291,7 +2291,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 @@ -2426,7 +2426,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, _, _)) = 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 @@ -2633,7 +2633,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. @@ -4033,7 +4033,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, _, _)) = ttrait match global_g with | None -> wordL (tagText "") | Some g -> @@ -5366,7 +5366,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)) -> Option.foldBack (accFreeVarsInTraitSln opts) sln.Value (accFreeVarsInTys opts tys (accFreeVarsInTys opts argTys diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index b5b738f8ada..f2fd9887772 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1437,7 +1437,7 @@ let p_trait_sln sln st = p_byte 7 st; p_tup4 p_ty (p_vref "trait") p_tys 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)) 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 = @@ -1477,7 +1477,7 @@ let u_trait_sln st = 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) + TTrait (a, b, c, d, e, ref None, ref f) let p_rational q st = p_int32 (GetNumerator q) st; p_int32 (GetDenominator q) st diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 20ffb4de64a..fc48c028ba1 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -147,6 +147,11 @@ Dostupná přetížení:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Obecná konstrukce vyžaduje, aby byl parametr obecného typu známý jako typ struct nebo reference. Zvažte možnost přidat anotaci typu. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 6844c4ebe7b..b5a49454df9 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -147,6 +147,11 @@ Verfügbare Überladungen:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Für ein generisches Konstrukt muss ein generischer Typparameter als Struktur- oder Verweistyp bekannt sein. Erwägen Sie das Hinzufügen einer Typanmerkung. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 797d8231cfd..4dc6a6713cd 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -147,6 +147,11 @@ Sobrecargas disponibles:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Una construcción genérica requiere que un parámetro de tipo genérico se conozca como tipo de referencia o estructura. Puede agregar una anotación de tipo. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index c3a07f32303..538b800e29d 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -147,6 +147,11 @@ Surcharges disponibles :\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. L'utilisation d'une construction générique est possible uniquement si un paramètre de type générique est connu en tant que type struct ou type référence. Ajoutez une annotation de type. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 1bbd6f3a48e..b5c3ac2c8f3 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -147,6 +147,11 @@ Overload disponibili:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Un costrutto generico richiede che un parametro di tipo generico sia noto come tipo riferimento o struct. Provare ad aggiungere un'annotazione di tipo. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 254548c4d61..7943618317f 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -147,6 +147,11 @@ 使用可能なオーバーロード:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. ジェネリック コンストラクトでは、ジェネリック型パラメーターが構造体または参照型として認識されている必要があります。型の注釈の追加を検討してください。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index f9fbab289f2..4c2816c22ab 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -147,6 +147,11 @@ 사용 가능한 오버로드:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. 제네릭 구문을 사용하려면 구조체 또는 참조 형식의 제네릭 형식 매개 변수가 필요합니다. 형식 주석을 추가하세요. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 075f8c0cc06..4db14e63e73 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -147,6 +147,11 @@ Dostępne przeciążenia:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Konstrukcja ogólna wymaga, aby parametr typu ogólnego był znany jako struktura lub typ referencyjny. Rozważ dodanie adnotacji typu. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 2fc380b9748..3bf88631e2a 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -147,6 +147,11 @@ Sobrecargas disponíveis:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Um constructo genérico exige que um parâmetro de tipo genérico seja conhecido como um tipo de referência ou struct. Considere adicionar uma anotação de tipo. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 85f28ad43be..a2e84f55e72 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -147,6 +147,11 @@ Доступные перегрузки:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. В универсальной конструкции требуется использовать параметр универсального типа, известный как структура или ссылочный тип. Рекомендуется добавить заметку с типом. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 843ad544e09..b0f5750e193 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -147,6 +147,11 @@ Kullanılabilir aşırı yüklemeler:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. Genel yapı, genel bir tür parametresinin yapı veya başvuru türü olarak bilinmesini gerektirir. Tür ek açıklaması eklemeyi düşünün. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 9c5c4fc8857..39b2583dbf5 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -147,6 +147,11 @@ 可用重载:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. 泛型构造要求泛型类型参数被视为结构或引用类型。请考虑添加类型注释。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 6992ddfd8b6..c55ca762564 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -147,6 +147,11 @@ 可用的多載:\n{0} + + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + '{0}' does not support the type '{1}', because the latter lacks the required (real or built-in) member '{2}' + + A generic construct requires that a generic type parameter be known as a struct or reference type. Consider adding a type annotation. 泛型建構要求泛型型別參數必須指定為結構或參考型別。請考慮新增型別註解。 diff --git a/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs index 3bb1770b411..b3c33031acb 100644 --- a/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs +++ b/tests/FSharp.Compiler.ComponentTests/ConstraintSolver/MemberConstraints.fs @@ -74,3 +74,43 @@ type DataItem< ^input> with """ |> compile |> shouldSucceed + + [] + let ``Indirect constraint by operator`` () = + FSharp """ +List.average [42] |> ignore +""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic + (Error 1, Line 2, Col 15, Line 2, Col 17, "'List.average' does not support the type 'int', because the latter lacks the required (real or built-in) member 'DivideByInt'") + + [] + let ``Direct constraint by named (pseudo) operator`` () = + FSharp """ +abs -1u |> ignore +""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic + (Error 1, Line 2, Col 6, Line 2, Col 8, "The type 'uint32' does not support the operator 'abs'") + + [] + let ``Direct constraint by simple operator`` () = + FSharp """ +"" >>> 1 |> ignore +""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic + (Error 1, Line 2, Col 1, Line 2, Col 3, "The type 'string' does not support the operator '>>>'") + + [] + let ``Direct constraint by pseudo operator`` () = + FSharp """ +ignore ["1" .. "42"] +""" + |> typecheck + |> shouldFail + |> withSingleDiagnostic + (Error 1, Line 2, Col 9, Line 2, Col 12, "The type 'string' does not support the operator 'op_Range'") diff --git a/tests/fsharp/Compiler/Libraries/Core/Operators/AbsTests.fs b/tests/fsharp/Compiler/Libraries/Core/Operators/AbsTests.fs index ca2f753de4e..a6e07ba38e4 100644 --- a/tests/fsharp/Compiler/Libraries/Core/Operators/AbsTests.fs +++ b/tests/fsharp/Compiler/Libraries/Core/Operators/AbsTests.fs @@ -29,7 +29,7 @@ abs -1uy |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'byte' does not support the operator 'Abs'" + "The type 'byte' does not support the operator 'abs'" [] let ``Abs of uint16``() = @@ -40,7 +40,7 @@ abs -1us |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint16' does not support the operator 'Abs'" + "The type 'uint16' does not support the operator 'abs'" [] let ``Abs of uint32``() = @@ -51,7 +51,7 @@ abs -1ul |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint32' does not support the operator 'Abs'" + "The type 'uint32' does not support the operator 'abs'" CompilerAssert.TypeCheckSingleError """ @@ -60,7 +60,7 @@ abs -1u |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 8) - "The type 'uint32' does not support the operator 'Abs'" + "The type 'uint32' does not support the operator 'abs'" [] let ``Abs of unativeint``() = @@ -71,7 +71,7 @@ abs -1un |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'unativeint' does not support the operator 'Abs'" + "The type 'unativeint' does not support the operator 'abs'" [] let ``Abs of uint64``() = @@ -82,7 +82,7 @@ abs -1uL |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint64' does not support the operator 'Abs'" + "The type 'uint64' does not support the operator 'abs'" CompilerAssert.TypeCheckSingleError """ @@ -91,4 +91,4 @@ abs -1UL |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint64' does not support the operator 'Abs'" \ No newline at end of file + "The type 'uint64' does not support the operator 'abs'" \ No newline at end of file diff --git a/tests/fsharp/Compiler/Libraries/Core/Operators/SignTests.fs b/tests/fsharp/Compiler/Libraries/Core/Operators/SignTests.fs index 2c67b1d1b8d..ca3edf8b377 100644 --- a/tests/fsharp/Compiler/Libraries/Core/Operators/SignTests.fs +++ b/tests/fsharp/Compiler/Libraries/Core/Operators/SignTests.fs @@ -45,7 +45,7 @@ sign 0uy |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'byte' does not support the operator 'get_Sign'" + "The type 'byte' does not support the operator 'sign'" [] let ``Sign of uint16``() = @@ -56,7 +56,7 @@ sign 0us |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint16' does not support the operator 'get_Sign'" + "The type 'uint16' does not support the operator 'sign'" [] let ``Sign of uint32``() = @@ -67,7 +67,7 @@ sign 0u |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 8) - "The type 'uint32' does not support the operator 'get_Sign'" + "The type 'uint32' does not support the operator 'sign'" [] let ``Sign of uint64``() = @@ -78,4 +78,4 @@ sign 0uL |> ignore FSharpDiagnosticSeverity.Error 1 (2, 6, 2, 9) - "The type 'uint64' does not support the operator 'get_Sign'" \ No newline at end of file + "The type 'uint64' does not support the operator 'sign'" \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg61.bsl b/tests/fsharp/typecheck/sigs/neg61.bsl index b1ba15a77ad..e0b2fb5eafb 100644 --- a/tests/fsharp/typecheck/sigs/neg61.bsl +++ b/tests/fsharp/typecheck/sigs/neg61.bsl @@ -71,7 +71,7 @@ neg61.fs(111,13,111,24): typecheck error FS3144: 'return' and 'return!' may not neg61.fs(114,13,114,21): typecheck error FS3145: This is not a known query operator. Query operators are identifiers such as 'select', 'where', 'sortBy', 'thenBy', 'groupBy', 'groupValBy', 'join', 'groupJoin', 'sumBy' and 'averageBy', defined using corresponding methods on the 'QueryBuilder' type. -neg61.fs(114,22,114,23): typecheck error FS0001: The type 'int' does not support the operator 'Truncate' +neg61.fs(114,22,114,23): typecheck error FS0001: The type 'int' does not support the operator 'truncate' neg61.fs(133,17,133,20): typecheck error FS3147: This 'let' definition may not be used in a query. Only simple value definitions may be used in queries. diff --git a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_NoMethodsOnEnums01.fs b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_NoMethodsOnEnums01.fs index b4e05661698..dca7226146d 100644 --- a/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_NoMethodsOnEnums01.fs +++ b/tests/fsharpqa/Source/Conformance/ObjectOrientedTypeDefinitions/EnumTypes/E_NoMethodsOnEnums01.fs @@ -1,6 +1,5 @@ // #Regression #Conformance #ObjectOrientedTypes #Enums -//Enumerations cannot have members$ -//The type 'Season' does not support the operator 'get_One'$ +//Enumerations cannot have members$ type Season = Spring=0 | Summer=1 | Autumn=2 | Winter=3 with @@ -8,5 +7,3 @@ type Season = Spring=0 | Summer=1 | Autumn=2 | Winter=3 let starti = Enum.to_int start let stopi = Enum.to_int stop { for i in starti .. stopi -> Enum.of_int i } - -printfn "%A" [Season.Spring .. Season.Autumn]