diff --git a/.vscode/launch.json b/.vscode/launch.json index d00e32e86bd..9d8255dfbee 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -23,7 +23,7 @@ "internalConsoleOptions": "neverOpen", "suppressJITOptimizations": true, "stopAtEntry": false, - "justMyCode": false, + "justMyCode": true, "enableStepFiltering": true, "symbolOptions": { "searchMicrosoftSymbolServer": true, @@ -73,7 +73,7 @@ "enabled": true } }, - "justMyCode": false, + "justMyCode": true, "enableStepFiltering": false, } ] diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 23e6186253a..c0104807dcc 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1370,7 +1370,7 @@ type ILInstr = | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs - | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs + | I_callconstraint of callvirt: bool * ILTailcall * ILType * ILMethodSpec * ILVarArgs | I_calli of ILTailcall * ILCallingSignature * ILVarArgs | I_ldftn of ILMethodSpec | I_newobj of ILMethodSpec * ILVarArgs @@ -3410,9 +3410,6 @@ let mkNormalCall mspec = I_call(Normalcall, mspec, None) let mkNormalCallvirt mspec = I_callvirt(Normalcall, mspec, None) -let mkNormalCallconstraint (ty, mspec) = - I_callconstraint(Normalcall, ty, mspec, None) - let mkNormalNewobj mspec = I_newobj(mspec, None) /// Comment on common object cache sizes: @@ -3822,18 +3819,24 @@ let mkILClassCtor impl = let mk_ospec (ty: ILType, callconv, nm, genparams, formal_args, formal_ret) = OverridesSpec(mkILMethRef (ty.TypeRef, callconv, nm, genparams, formal_args, formal_ret), ty) -let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = +let mkILGenericVirtualMethod (nm, callconv: ILCallingConv, access, genparams, actual_args, actual_ret, impl) = + let attributes = + convertMemberAccess access + ||| MethodAttributes.CheckAccessOnOverride + ||| (match impl with + | MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual + | _ -> MethodAttributes.Virtual) + ||| (if callconv.IsInstance then + enum 0 + else + MethodAttributes.Static) + ILMethodDef( name = nm, - attributes = - (convertMemberAccess access - ||| MethodAttributes.CheckAccessOnOverride - ||| (match impl with - | MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual - | _ -> MethodAttributes.Virtual)), + attributes = attributes, implAttributes = MethodImplAttributes.Managed, genericParams = genparams, - callingConv = ILCallingConv.Instance, + callingConv = callconv, parameters = actual_args, ret = actual_ret, isEntryPoint = false, @@ -3842,8 +3845,11 @@ let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, im body = notlazy impl ) -let mkILNonGenericVirtualMethod (nm, access, args, ret, impl) = - mkILGenericVirtualMethod (nm, access, mkILEmptyGenericParams, args, ret, impl) +let mkILNonGenericVirtualMethod (nm, callconv, access, args, ret, impl) = + mkILGenericVirtualMethod (nm, callconv, access, mkILEmptyGenericParams, args, ret, impl) + +let mkILNonGenericVirtualInstanceMethod (nm, access, args, ret, impl) = + mkILNonGenericVirtualMethod (nm, ILCallingConv.Instance, access, args, ret, impl) let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = ILMethodDef( @@ -4267,7 +4273,7 @@ let mkILDelegateMethods access (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IAsy let one nm args ret = let mdef = - mkILNonGenericVirtualMethod (nm, access, args, mkILReturn ret, MethodBody.Abstract) + mkILNonGenericVirtualInstanceMethod (nm, access, args, mkILReturn ret, MethodBody.Abstract) mdef.WithAbstract(false).WithHideBySig(true).WithRuntime(true) @@ -5298,7 +5304,7 @@ and refsOfILInstr s x = | I_callvirt (_, mr, varargs) -> refsOfILMethodSpec s mr refsOfILVarArgs s varargs - | I_callconstraint (_, tr, mr, varargs) -> + | I_callconstraint (_, _, tr, mr, varargs) -> refsOfILType s tr refsOfILMethodSpec s mr refsOfILVarArgs s varargs diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 8b5a3160c06..32528348907 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -523,7 +523,7 @@ type internal ILInstr = // Method call | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs - | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs + | I_callconstraint of callvirt: bool * ILTailcall * ILType * ILMethodSpec * ILVarArgs | I_calli of ILTailcall * ILCallingSignature * ILVarArgs | I_ldftn of ILMethodSpec | I_newobj of ILMethodSpec * ILVarArgs @@ -1970,7 +1970,6 @@ type internal ILLocalsAllocator = /// Derived functions for making some common patterns of instructions. val internal mkNormalCall: ILMethodSpec -> ILInstr val internal mkNormalCallvirt: ILMethodSpec -> ILInstr -val internal mkNormalCallconstraint: ILType * ILMethodSpec -> ILInstr val internal mkNormalNewobj: ILMethodSpec -> ILInstr val internal mkCallBaseConstructor: ILType * ILType list -> ILInstr list val internal mkNormalStfld: ILFieldSpec -> ILInstr @@ -2025,12 +2024,16 @@ val internal mkILNonGenericStaticMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILGenericVirtualMethod: - string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef + string * ILCallingConv * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> + ILMethodDef val internal mkILGenericNonVirtualMethod: string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILNonGenericVirtualMethod: + string * ILCallingConv * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef + +val internal mkILNonGenericVirtualInstanceMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILNonGenericInstanceMethod: diff --git a/src/Compiler/AbstractIL/ilmorph.fs b/src/Compiler/AbstractIL/ilmorph.fs index bcc65878d1a..dad1e16369d 100644 --- a/src/Compiler/AbstractIL/ilmorph.fs +++ b/src/Compiler/AbstractIL/ilmorph.fs @@ -212,7 +212,8 @@ let morphILTypesInILInstr ((factualTy, fformalTy)) i = | I_calli (a, mref, varargs) -> I_calli(a, callsig_ty2ty factualTy mref, morphILVarArgs factualTy varargs) | I_call (a, mr, varargs) -> I_call(a, conv_mspec mr, morphILVarArgs factualTy varargs) | I_callvirt (a, mr, varargs) -> I_callvirt(a, conv_mspec mr, morphILVarArgs factualTy varargs) - | I_callconstraint (a, ty, mr, varargs) -> I_callconstraint(a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) + | I_callconstraint (callvirt, a, ty, mr, varargs) -> + I_callconstraint(callvirt, a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) | I_newobj (mr, varargs) -> I_newobj(conv_mspec mr, morphILVarArgs factualTy varargs) | I_ldftn mr -> I_ldftn(conv_mspec mr) | I_ldvirtftn mr -> I_ldvirtftn(conv_mspec mr) diff --git a/src/Compiler/AbstractIL/ilprint.fs b/src/Compiler/AbstractIL/ilprint.fs index 1c777f278b9..0335e28ef22 100644 --- a/src/Compiler/AbstractIL/ilprint.fs +++ b/src/Compiler/AbstractIL/ilprint.fs @@ -893,11 +893,11 @@ let rec goutput_instr env os inst = output_string os "callvirt " goutput_vararg_mspec env os (mspec, varargs) output_after_tailcall os tl - | I_callconstraint (tl, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tl, ty, mspec, varargs) -> output_tailness os tl output_string os "constraint. " goutput_typ env os ty - output_string os " callvirt " + output_string os (if callvirt then " callvirt " else " call ") goutput_vararg_mspec env os (mspec, varargs) output_after_tailcall os tl | I_castclass ty -> diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 964d4d2b779..52b1a7c4230 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -626,17 +626,23 @@ let instrs () = i_stsfld, I_field_instr(volatilePrefix (fun x fspec -> I_stsfld(x, fspec))) i_ldflda, I_field_instr(noPrefixes I_ldflda) i_ldsflda, I_field_instr(noPrefixes I_ldsflda) - i_call, I_method_instr(tailPrefix (fun tl (mspec, y) -> I_call(tl, mspec, y))) + (i_call, + I_method_instr( + constraintOrTailPrefix (fun (c, tl) (mspec, y) -> + match c with + | Some ty -> I_callconstraint(false, tl, ty, mspec, y) + | None -> I_call(tl, mspec, y)) + )) i_ldftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldftn mspec)) i_ldvirtftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec)) i_newobj, I_method_instr(noPrefixes I_newobj) - i_callvirt, - I_method_instr( - constraintOrTailPrefix (fun (c, tl) (mspec, y) -> - match c with - | Some ty -> I_callconstraint(tl, ty, mspec, y) - | None -> I_callvirt(tl, mspec, y)) - ) + (i_callvirt, + I_method_instr( + constraintOrTailPrefix (fun (c, tl) (mspec, y) -> + match c with + | Some ty -> I_callconstraint(true, tl, ty, mspec, y) + | None -> I_callvirt(tl, mspec, y)) + )) i_leave_s, I_unconditional_i8_instr(noPrefixes (fun x -> I_leave x)) i_br_s, I_unconditional_i8_instr(noPrefixes I_br) i_leave, I_unconditional_i32_instr(noPrefixes (fun x -> I_leave x)) diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index a53af4220f3..86787b11f00 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -1391,9 +1391,10 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = emitSilverlightCheck ilG emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_callconstraint (tail, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tail, ty, mspec, varargs) -> ilG.Emit(OpCodes.Constrained, convType cenv emEnv ty) - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + let instr = if callvirt then OpCodes.Callvirt else OpCodes.Call + emitInstrCall cenv emEnv ilG instr tail mspec varargs | I_calli (tail, callsig, None) -> emitInstrTail cenv ilG tail (fun () -> diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 9349020f4f6..702fbd5eedb 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -1922,10 +1922,11 @@ module Codebuf = emitTailness cenv codebuf tl emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callconstraint (tl, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tl, ty, mspec, varargs) -> emitTailness cenv codebuf tl emitConstrained cenv codebuf env ty - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) + let instr = if callvirt then i_callvirt else i_call + emitMethodSpecInstr cenv codebuf env instr (mspec, varargs) //emitAfterTailcall codebuf tl | I_newobj (mspec, varargs) -> emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 523a0aa10c7..0693609fa64 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -468,7 +468,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol match info with | None -> false | Some args -> - args |> List.exists (fun (isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo) -> isParamArrayArg || isOutArg || optArgInfo.IsOptional)) + args |> List.exists (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> isParamArrayArg || isOutArg || optArgInfo.IsOptional)) else false diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 5cf36acb80d..08bffa54a57 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -414,7 +414,7 @@ module TcRecdUnionAndEnumDeclarations = let attrsForProperty, attrsForField = attrs |> List.partition (fun (attrTargets, _) -> (attrTargets &&& AttributeTargets.Property) <> enum 0) let attrsForProperty = (List.map snd attrsForProperty) let attrsForField = (List.map snd attrsForField) - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let zeroInit = HasFSharpAttribute g g.attrib_DefaultValueAttribute attrsForField let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute attrsForField @@ -512,7 +512,7 @@ module TcRecdUnionAndEnumDeclarations = rfields, thisTy | SynUnionCaseKind.FullType (ty, arity) -> - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let curriedArgTys, recordTy = GetTopTauTypeInFSharpForm g (arity |> TranslateSynValInfo m (TcAttributes cenv env) |> TranslatePartialValReprInfo []).ArgInfos tyR m if curriedArgTys.Length > 1 then @@ -666,7 +666,7 @@ let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl - let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType + let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open WarnOnIWSAM.Yes env emptyUnscopedTyparEnv synType if not (isAppTy g ty) then error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m)) @@ -1054,7 +1054,7 @@ module MutRecBindingChecking = // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call | Phase2AInherit (synBaseTy, arg, baseValOpt, m) -> - let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use envInstance tpenv synBaseTy + let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g let inheritsExpr, tpenv = try @@ -1630,7 +1630,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let intfTyR = let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForTycon - TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner emptyUnscopedTyparEnv intfTy |> fst + TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.No envinner emptyUnscopedTyparEnv intfTy |> fst if not (tcref.HasInterface g intfTyR) then error(Error(FSComp.SR.tcAllImplementedInterfacesShouldBeDeclared(), intfTy.Range)) @@ -2358,11 +2358,11 @@ module EstablishTypeDefinitionCores = match args with | SynUnionCaseKind.Fields flds -> for SynField(_, _, _, ty, _, _, _, m) in flds do - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) | SynUnionCaseKind.FullType (ty, arity) -> - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let curriedArgTys, _ = GetTopTauTypeInFSharpForm g (arity |> TranslateSynValInfo m (TcAttributes cenv env) |> TranslatePartialValReprInfo []).ArgInfos tyR m if curriedArgTys.Length > 1 then @@ -2373,9 +2373,10 @@ module EstablishTypeDefinitionCores = yield (argTy, m) | SynTypeDefnSimpleRepr.General (_, _, _, fields, _, _, implicitCtorSynPats, _) when tycon.IsFSharpStructOrEnumTycon -> // for structs - for SynField(_, isStatic, _, ty, _, _, _, m) in fields do + for field in fields do + let (SynField(_, isStatic, _, ty, _, _, _, m)) = field if not isStatic then - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) match implicitCtorSynPats with @@ -2394,7 +2395,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Record (_, fields, _) -> for SynField(_, _, _, ty, _, _, _, m) in fields do - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) | _ -> @@ -2928,7 +2929,7 @@ module EstablishTypeDefinitionCores = // This case deals with ordinary type and measure abbreviations if not hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner tpenv rhsType + let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType if not firstPass then let ftyvs = freeInTypeLeftToRight g false ty @@ -2962,7 +2963,7 @@ module EstablishTypeDefinitionCores = let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner tcref false - let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner)) tpenv explicitImplements + let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner)) tpenv explicitImplements if firstPass then tycon.entity_attribs <- attrs @@ -2974,7 +2975,7 @@ module EstablishTypeDefinitionCores = let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) let inherits = inherits |> List.map (fun (ty, m, _) -> (ty, m)) - let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner)) tpenv inherits) + let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner)) tpenv inherits) let implementedTys, inheritedTys = match kind with | SynTypeDefnKind.Interface -> @@ -3215,7 +3216,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv rhsType + let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType TMeasureableRepr theTypeAbbrev, None, NoSafeInitInfo // If we already computed a representation, e.g. for a generative type definition, then don't change it here. @@ -3339,7 +3340,7 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() noFieldsCheck userFields primaryConstructorInDelegateCheck(implicitCtorSynPats) - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv ty let _, _, curriedArgInfos, returnTy, _ = GetValReprTypeInCompiledForm g (arity |> TranslateSynValInfo m (TcAttributes cenv envinner) |> TranslatePartialValReprInfo []) 0 tyR m if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(), m)) if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(), m)) @@ -4027,14 +4028,15 @@ module TcDeclarations = // Convert auto properties to member bindings in the post-list let rec postAutoProps memb = match memb with - | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; xmlDoc=xmlDoc; accessibility=access; getSetRange=mGetSetOpt) -> + | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; getSetRange=mGetSetOpt) -> let mMemberPortion = id.idRange // Only the keep the non-field-targeted attributes let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) - let memberFlags kind = Some { memberFlags kind with GetterOrSetterIsCompilerGenerated = true } + let memberFlags = { memberFlags with GetterOrSetterIsCompilerGenerated = true } + let memberFlagsForSet = { memberFlagsForSet with GetterOrSetterIsCompilerGenerated = true } match propKind, mGetSetOpt with | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) @@ -4049,7 +4051,7 @@ module TcDeclarations = let rhsExpr = SynExpr.Ident fldId let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let attribs = mkAttributeList attribs mMemberPortion - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, memberFlags SynMemberKind.Member, SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield getter | _ -> () @@ -4061,8 +4063,7 @@ module TcDeclarations = let vId = ident("v", mMemberPortion) let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) - //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], memberFlags SynMemberKind.PropertySet, SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield setter | _ -> ()] diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d659fc28967..8f034836dd9 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -717,7 +717,7 @@ type TcFileState = tcComputationExpression) = let infoReader = InfoReader(g, amap) - let instantiationGenerator m tpsorig = FreshenTypars m tpsorig + let instantiationGenerator m tpsorig = FreshenTypars g m tpsorig let nameResolver = NameResolver(g, amap, infoReader, instantiationGenerator) { g = g amap = amap @@ -749,8 +749,8 @@ type TcFileState = type cenv = TcFileState -let CopyAndFixupTypars m rigid tpsorig = - FreshenAndFixupTypars m rigid [] [] tpsorig +let CopyAndFixupTypars g m rigid tpsorig = + FreshenAndFixupTypars g m rigid [] [] tpsorig let UnifyTypes (cenv: cenv) (env: TcEnv) m actualTy expectedTy = let g = cenv.g @@ -1314,13 +1314,16 @@ let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, implS let isInstance = MemberIsCompiledAsInstance g tcref isExtrinsic memberInfo attrs - if (memberFlags.IsDispatchSlot || not (isNil intfSlotTys)) then - if not isInstance then - errorR(VirtualAugmentationOnNullValuedType(id.idRange)) + let hasUseNullAsTrueAttr = TyconHasUseNullAsTrueValueAttribute g tcref.Deref - elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then - if not isExtrinsic && not isInstance then - warning(NonVirtualAugmentationOnNullValuedType(id.idRange)) + if hasUseNullAsTrueAttr then + if (memberFlags.IsDispatchSlot || not (isNil intfSlotTys)) then + if not isInstance then + errorR(VirtualAugmentationOnNullValuedType(id.idRange)) + + elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then + if not isExtrinsic && not isInstance then + warning(NonVirtualAugmentationOnNullValuedType(id.idRange)) let compiledName = if isExtrinsic then @@ -1524,7 +1527,7 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf if requiredProps.Length > 0 then let setterPropNames = finalAssignedItemSetters - |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (pinfo, _, _), _) -> Some pinfo.PropertyName | _ -> None) + |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (_, pinfo, _, _), _) -> Some pinfo.PropertyName | _ -> None) let missingProps = requiredProps @@ -1804,11 +1807,11 @@ let SetTyparRigid denv m (tp: Typar) = errorR(Error(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), tp.Range)) tp.SetRigidity TyparRigidity.Rigid -let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsForThisBinding - (PrelimVal1(id, explicitTyparInfo, ty, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen)) = +let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsForThisBinding prelimVal = let g = cenv.g + let (PrelimVal1(id, explicitTyparInfo, ty, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen)) = prelimVal let (ExplicitTyparInfo(_rigidCopyOfDeclaredTypars, declaredTypars, _)) = explicitTyparInfo let m = id.idRange @@ -1837,8 +1840,10 @@ let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsFor warning(Error(FSComp.SR.tcTypeParametersInferredAreNotStable(), m)) let hasDeclaredTypars = not (isNil declaredTypars) + // This is just about the only place we form a GeneralizedType let tyScheme = GeneralizedType(generalizedTypars, ty) + PrelimVal2(id, tyScheme, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen, hasDeclaredTypars) let GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars types = @@ -2041,7 +2046,8 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = let origTypars = declaredTyconTypars - let freshTypars = copyTypars origTypars + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let freshTypars = copyTypars clearStaticReq origTypars if rigid <> TyparRigidity.Rigid then for tp in freshTypars do tp.SetRigidity rigid @@ -2058,11 +2064,11 @@ let FreshenPossibleForallTy g m rigid ty = 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 m rigid origTypars + let tps, renaming, tinst = CopyAndFixupTypars g m rigid origTypars origTypars, tps, tinst, instType renaming tau let FreshenTyconRef2 (g: TcGlobals) m (tcref: TyconRef) = - let tps, renaming, tinst = FreshenTypeInst m (tcref.Typars m) + let tps, renaming, tinst = FreshenTypeInst g 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 @@ -2089,7 +2095,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 m rigid ttps ttinst fmtps + FreshenAndFixupTypars g m rigid ttps ttinst fmtps // Work out the required type of the member let argTysFromAbsSlot = argTys |> List.mapSquared (instType typarInstFromAbsSlot) @@ -2447,6 +2453,10 @@ module GeneralizationHelpers = then (ListSet.unionFavourLeft typarEq allDeclaredTypars maxInferredTypars) else allDeclaredTypars + // Update the StaticReq of type variables prior to assessing generalization + for typar in typarsToAttemptToGeneralize do + UpdateStaticReqOfTypar denv cenv.css m NoTrace typar + let generalizedTypars, freeInEnv = TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag typarsToAttemptToGeneralize freeInEnv @@ -3055,18 +3065,20 @@ type ApplicableExpr = // the function-valued expression expr: Expr * // is this the first in an application series - isFirst: bool + isFirst: bool * + // Is this a traitCall, where we don't build a lambda + traitCallInfo: (Val list * Expr) option member x.Range = - let (ApplicableExpr (_, expr, _)) = x + let (ApplicableExpr (_, expr, _, _)) = x expr.Range member x.Type = match x with - | ApplicableExpr (cenv, expr, _) -> tyOfExpr cenv.g expr + | ApplicableExpr (cenv, expr, _, _) -> tyOfExpr cenv.g expr member x.SupplyArgument(expr2, m) = - let (ApplicableExpr (cenv, funcExpr, first)) = x + let (ApplicableExpr (cenv, funcExpr, first, traitCallInfo)) = x let g = cenv.g let combinedExpr = @@ -3076,16 +3088,24 @@ type ApplicableExpr = (not (isForallTy g funcExpr0Ty) || isFunTy g (applyTys g funcExpr0Ty (tyargs0, args0))) -> Expr.App (funcExpr0, funcExpr0Ty, tyargs0, args0@[expr2], unionRanges m0 m) | _ -> - Expr.App (funcExpr, tyOfExpr g funcExpr, [], [expr2], m) + // Trait calls do not build a lambda if applied immediately to a tuple of arguments or a unit argument + match traitCallInfo, tryDestRefTupleExpr expr2 with + | Some (vs, traitCall), exprs when vs.Length = exprs.Length -> + mkLetsBind m (mkCompGenBinds vs exprs) traitCall + | _ -> + Expr.App (funcExpr, tyOfExpr g funcExpr, [], [expr2], m) - ApplicableExpr(cenv, combinedExpr, false) + ApplicableExpr(cenv, combinedExpr, false, None) member x.Expr = - let (ApplicableExpr (_, expr, _)) = x + let (ApplicableExpr (_, expr, _, _)) = x expr let MakeApplicableExprNoFlex cenv expr = - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) + +let MakeApplicableExprForTraitCall cenv expr traitCallInfo = + ApplicableExpr (cenv, expr, true, Some traitCallInfo) /// This function reverses the effect of condensation for a named function value (indeed it can /// work for any expression, though we only invoke it immediately after a call to TcVal). @@ -3131,7 +3151,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = curriedActualTys |> List.exists (List.exists (isByrefTy g)) || curriedActualTys |> List.forall (List.forall (isNonFlexibleTy g))) then - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) else let curriedFlexibleTys = curriedActualTys |> List.mapSquared (fun actualTy -> @@ -3144,7 +3164,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = // Create a coercion to represent the expansion of the application let expr = mkCoerceExpr (expr, mkIteratedFunTy g (List.map (mkRefTupledTy g) curriedFlexibleTys) retTy, m, exprTy) - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) /// Checks, warnings and constraint assertions for downcasts let TcRuntimeTypeTest isCast isOperator cenv denv m tgtTy srcTy = @@ -3192,7 +3212,7 @@ let TcStaticUpcast cenv denv m tgtTy srcTy = AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace tgtTy srcTy -let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo valUseFlags minst objArgs args = +let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt = let g = cenv.g @@ -3226,7 +3246,7 @@ let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo let _, exprForVal, _, tau, _, _ = TcVal true cenv env emptyUnscopedTyparEnv valref (Some (valUse, (fun x _ -> ttypes, x))) None m exprForVal, tau - BuildMethodCall tcVal g cenv.amap isMutable m isProp minfo valUseFlags minst objArgs args + BuildMethodCall tcVal g cenv.amap isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = @@ -3269,13 +3289,13 @@ let BuildDisposableCleanup (cenv: cenv) env m (v: Val) = if TypeFeasiblySubsumesType 0 g cenv.amap m g.system_IDisposable_ty CanCoerce v.Type then // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive // copy of it. - let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] None disposeExpr else mkUnit g m else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) @@ -3289,7 +3309,7 @@ let BuildOffsetToStringData cenv env m = | [x] -> x | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(), m)) - let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] + let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] None offsetExpr let BuildILFieldGet g amap m objExpr (finfo: ILFieldInfo) = @@ -3550,7 +3570,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr mkCompGenLocal m "enumerator" getEnumeratorRetTy, getEnumeratorRetTy let getEnumExpr, getEnumTy = - let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumeratorMethInfo NormalValUse getEnumeratorMethInst [exprToSearchForGetEnumeratorAndItem] [] + let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumeratorMethInfo NormalValUse getEnumeratorMethInst [exprToSearchForGetEnumeratorAndItem] [] None if not isEnumeratorTypeStruct || localAlloc then res else // wrap enumerators that are represented as mutable structs into ref cells @@ -3558,8 +3578,8 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr let getEnumTy = mkRefCellTy g getEnumTy getEnumExpr, getEnumTy - let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNextMethInfo NormalValUse moveNextMethInst [enumeratorExpr] [] - let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true getCurrentMethInfo NormalValUse getCurrentMethInst [enumeratorExpr] [] + let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNextMethInfo NormalValUse moveNextMethInst [enumeratorExpr] [] None + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true getCurrentMethInfo NormalValUse getCurrentMethInst [enumeratorExpr] [] None let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) let currentExpr, enumElemTy = // Implicitly dereference byref for expr 'for x in ...' @@ -3963,19 +3983,19 @@ let buildApp cenv expr resultTy arg m = match expr, arg with // Special rule for building applications of the 'x && y' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [x0], _)), _ when valRefEq g vref g.and_vref || valRefEq g vref g.and2_vref -> MakeApplicableExprNoFlex cenv (mkLazyAnd g m x0 arg), resultTy // Special rule for building applications of the 'x || y' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [x0], _)), _ when valRefEq g vref g.or_vref || valRefEq g vref g.or2_vref -> MakeApplicableExprNoFlex cenv (mkLazyOr g m x0 arg ), resultTy // Special rule for building applications of the 'reraise' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.reraise_vref -> // exprTy is of type: "unit -> 'a". Break it and store the 'a type here, used later as return type. @@ -3983,7 +4003,7 @@ let buildApp cenv expr resultTy arg m = // Special rules for NativePtr.ofByRef to generalize result. // See RFC FS-1053.md - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when (valRefEq g vref g.nativeptr_tobyref_vref) -> let argTy = NewInferenceType g @@ -3994,7 +4014,7 @@ let buildApp cenv expr resultTy arg m = // address of an expression. // // See also RFC FS-1053.md - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.addrof_vref -> let wrap, e1a', readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some vref) m @@ -4019,7 +4039,7 @@ let buildApp cenv expr resultTy arg m = // Special rules for building applications of the &&expr' operators, which gets the // address of an expression. - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.addrof2_vref -> warning(UseOfAddressOfOperator m) @@ -4083,6 +4103,13 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +/// Indicates whether the position being checked is precisely the r.h.s. of a "'T :> ***" constraint or a similar +/// places where IWSAM types do not generate a warning +[] +type WarnOnIWSAM = + | Yes + | No + /// Represents information about the module or type in which a member or value is declared. type MemberOrValContainerInfo = | MemberOrValContainerInfo of @@ -4214,13 +4241,13 @@ let rec TcTyparConstraint ridx cenv newOk checkConstraints occ (env: TcEnv) tpen match c with | SynTypeConstraint.WhereTyparDefaultsToType(tp, ty, m) -> - let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty let tpR, tpenv = TcTypar cenv env newOk tpenv tp AddCxTyparDefaultsTo env.DisplayEnv cenv.css m env.eContextInfo tpR ridx tyR tpenv | SynTypeConstraint.WhereTyparSubtypeOfType(tp, ty, m) -> - let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv ty + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No env tpenv ty let tpR, tpenv = TcTypar cenv env newOk tpenv tp if newOk = NoNewTypars && isSealedTy g tyR then errorR(Error(FSComp.SR.tcInvalidConstraintTypeSealed(), m)) @@ -4254,12 +4281,32 @@ let rec TcTyparConstraint ridx cenv newOk checkConstraints occ (env: TcEnv) tpen | SynTypeConstraint.WhereTyparSupportsMember(synSupportTys, synMemberSig, m) -> TcConstraintWhereTyparSupportsMember cenv env newOk tpenv synSupportTys synMemberSig m + | SynTypeConstraint.WhereSelfConstrained(ty, m) -> + checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SelfTypeConstraints m + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No env tpenv ty + match tyR with + | TType_app(tcref, tinst, _) when (tcref.IsTypeAbbrev && (isTyparTy g tcref.TypeAbbrev.Value) && tinst |> List.forall (isTyparTy g)) -> + match checkConstraints with + | NoCheckCxs -> + //let formalEnclosingTypars = [] + let tpsorig = tcref.Typars(m) //List.map (destTyparTy g) inst //, _, tinst, _ = FreshenTyconRef2 g m tcref + 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)) + | CheckCxs -> () + | AppTy g (_tcref, selfTy :: _rest) when isTyparTy g selfTy && isInterfaceTy g tyR -> + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace tyR selfTy + | _ -> + errorR(Error(FSComp.SR.tcInvalidSelfConstraint(), m)) + tpenv + and TcConstraintWhereTyparIsEnum cenv env newOk checkConstraints tpenv tp synUnderlingTys m = let tpR, tpenv = TcTypar cenv env newOk tpenv tp let tpenv = match synUnderlingTys with | [synUnderlyingTy] -> - let underlyingTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv synUnderlyingTy + let underlyingTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synUnderlyingTy AddCxTypeIsEnum env.DisplayEnv cenv.css m NoTrace (mkTyparTy tpR) underlyingTy tpenv | _ -> @@ -4271,8 +4318,8 @@ and TcConstraintWhereTyparIsDelegate cenv env newOk checkConstraints occ tpenv t let tpR, tpenv = TcTypar cenv env newOk tpenv tp match synTys with | [a;b] -> - let a', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv a - let b', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv b + let a', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv a + let b', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv b AddCxTypeIsDelegate env.DisplayEnv cenv.css m NoTrace (mkTyparTy tpR) a' b' tpenv | _ -> @@ -4303,7 +4350,7 @@ and TcSimpleTyparConstraint cenv env newOk tpenv tp m constraintAdder = and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let g = cenv.g - let tys, tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType env) tpenv synTypes + let tys, tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env) tpenv synTypes match synMemberSig with | SynMemberSig.Member (synValSig, memberFlags, m) -> @@ -4319,6 +4366,15 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let argTys = List.concat curriedArgInfos let argTys = List.map fst argTys let logicalCompiledName = ComputeLogicalName id memberFlags + for argInfos in curriedArgInfos do + for argInfo in argInfos do + let info = CrackParamAttribsInfo g argInfo + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info + if isParamArrayArg || isInArg || isOutArg || optArgInfo.IsOptional || callerInfo <> CallerInfo.NoCallerInfo || reflArgInfo <> ReflectedArgInfo.None then + if g.langVersion.SupportsFeature(LanguageFeature.InterfacesWithAbstractStaticMembers) then + errorR(Error(FSComp.SR.tcTraitMayNotUseComplexThings(), m)) + else + warning(Error(FSComp.SR.tcTraitMayNotUseComplexThings(), m)) let item = Item.ArgName (Some id, memberConstraintTy, None, id.idRange) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) @@ -4370,7 +4426,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv allDeclaredTypars |> List.iter (SetTyparRigid env.DisplayEnv m) // Process the type, including any constraints - let declaredTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType envinner tpenv ty + let declaredTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv ty match memFlagsOpt, thisTyOpt with | Some memberFlags, Some thisTy -> @@ -4528,7 +4584,7 @@ and TcTypeOrMeasureParameter kindOpt cenv (env: TcEnv) newOk tpenv (SynTypar(id, tpR, AddUnscopedTypar key tpR tpenv -and TcTypar cenv env newOk tpenv tp = +and TcTypar cenv env newOk tpenv tp : Typar * UnscopedTyparEnv = TcTypeOrMeasureParameter (Some TyparKind.Type) cenv env newOk tpenv tp and TcTyparDecl cenv env synTyparDecl = @@ -4563,7 +4619,7 @@ and TcTyparDecls cenv env synTypars = /// If kindOpt=Some kind, then this is the kind we're expecting (we're doing kind checking) /// If kindOpt=None, we need to determine the kind (we're doing kind inference) /// -and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) synTy = +and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ (iwsam: WarnOnIWSAM) env (tpenv: UnscopedTyparEnv) synTy = let g = cenv.g match synTy with @@ -4572,13 +4628,13 @@ and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: Unscoped g.obj_ty, tpenv | SynType.LongIdent synLongId -> - TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId + TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId | SynType.App (StripParenTypes (SynType.LongIdent longId), _, args, _, _, postfix, m) -> - TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId postfix args m + TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m | SynType.LongIdentApp (synLeftTy, synLongId, _, args, _commas, _, m) -> - TcNestedAppType cenv newOk checkConstraints occ env tpenv synLeftTy synLongId args m + TcNestedAppType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy synLongId args m | SynType.Tuple(isStruct, segments, m) -> TcTupleType kindOpt cenv newOk checkConstraints occ env tpenv isStruct segments m @@ -4625,13 +4681,27 @@ and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: Unscoped TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args postfix m | SynType.Paren(innerType, _) -> - TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env tpenv innerType + TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ iwsam env tpenv innerType -and TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId = +and CheckIWSAM (cenv: cenv) (env: TcEnv) checkConstraints iwsam m tcref = + let g = cenv.g + let ad = env.eAccessRights + let ty = generalizedTyconRef g tcref + if iwsam = WarnOnIWSAM.Yes && isInterfaceTy g ty && checkConstraints = CheckCxs then + let tcref = tcrefOfAppTy g ty + let meths = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides m ty + if meths |> List.exists (fun meth -> not meth.IsInstance && meth.IsDispatchSlot) then + warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)) + +and TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId = let (SynLongIdent(tc, _, _)) = synLongId 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) + + CheckIWSAM cenv env checkConstraints iwsam m tcref + match kindOpt, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4646,7 +4716,7 @@ and TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId = /// Some.Long.TypeName /// ty1 SomeLongTypeName -and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId postfix args m = +and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m = let (SynLongIdent(tc, _, _)) = longId let ad = env.eAccessRights @@ -4655,6 +4725,8 @@ and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise + CheckIWSAM cenv env checkConstraints iwsam m tcref + match kindOpt, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4679,11 +4751,11 @@ and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId errorR(Error(FSComp.SR.tcUnitsOfMeasureInvalidInTypeConstructor(), m)) NewErrorType (), tpenv -and TcNestedAppType cenv newOk checkConstraints occ env tpenv synLeftTy synLongId args m = +and TcNestedAppType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy synLongId args m = let g = cenv.g let ad = env.eAccessRights let (SynLongIdent(longId, _, _)) = synLongId - let leftTy, tpenv = TcType cenv newOk checkConstraints occ env tpenv synLeftTy + 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 @@ -4734,14 +4806,14 @@ and TcAnonRecdType cenv newOk checkConstraints occ env tpenv isStruct args m = and TcFunctionType cenv newOk checkConstraints occ env tpenv domainTy resultTy = let g = cenv.g - let domainTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv domainTy - let resultTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv resultTy + let domainTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv domainTy + let resultTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv resultTy let tyR = mkFunTy g domainTyR resultTyR tyR, tpenv and TcElementType cenv newOk checkConstraints occ env tpenv rank elemTy m = let g = cenv.g - let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv elemTy + let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv elemTy let tyR = mkArrayTy g rank elemTy m tyR, tpenv @@ -4759,14 +4831,14 @@ and TcAnonType kindOpt cenv newOk tpenv m = | TyparKind.Type -> mkTyparTy tp, tpenv and TcTypeWithConstraints cenv env newOk checkConstraints occ tpenv synTy synConstraints = - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv synTy + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv synTy let tpenv = TcTyparConstraints cenv newOk checkConstraints occ env tpenv synConstraints ty, tpenv // #typ and TcTypeHashConstraint cenv env newOk checkConstraints occ tpenv synTy m = let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv synTy + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.No env tpenv synTy AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty (mkTyparTy tp) tp.AsType, tpenv @@ -4816,8 +4888,8 @@ and TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args errorR(Error(FSComp.SR.tcIllegalSyntaxInTypeExpression(), m)) NewErrorType (), tpenv -and TcType cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) ty = - TcTypeOrMeasure (Some TyparKind.Type) cenv newOk checkConstraints occ env tpenv ty +and TcType cenv newOk checkConstraints occ iwsam env (tpenv: UnscopedTyparEnv) ty = + TcTypeOrMeasure (Some TyparKind.Type) cenv newOk checkConstraints occ iwsam env tpenv ty and TcMeasure cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) (StripParenTypes ty) m = match ty with @@ -4825,7 +4897,7 @@ and TcMeasure cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) (Str error(Error(FSComp.SR.tcAnonymousUnitsOfMeasureCannotBeNested(), m)) NewErrorMeasure (), tpenv | _ -> - match TcTypeOrMeasure (Some TyparKind.Measure) cenv newOk checkConstraints occ env tpenv ty with + match TcTypeOrMeasure (Some TyparKind.Measure) cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty with | TType_measure ms, tpenv -> ms, tpenv | _ -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) @@ -4847,8 +4919,8 @@ and TcAnonTypeOrMeasure kindOpt _cenv rigid dyn newOk m = NewAnonTypar (kind, m, rigid, TyparStaticReq.None, dyn) -and TcTypes cenv newOk checkConstraints occ env tpenv args = - List.mapFold (TcTypeAndRecover cenv newOk checkConstraints occ env) tpenv args +and TcTypes cenv newOk checkConstraints occ iwsam env tpenv args = + List.mapFold (TcTypeAndRecover cenv newOk checkConstraints occ iwsam env) tpenv args and TcTypesAsTuple cenv newOk checkConstraints occ env tpenv (args: SynTupleTypeSegment list) m = let hasASlash = @@ -4860,9 +4932,9 @@ and TcTypesAsTuple cenv newOk checkConstraints occ env tpenv (args: SynTupleType let args : SynType list = getTypeFromTuplePath args match args with | [] -> error(InternalError("empty tuple type", m)) - | [ty] -> let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty in [ty], tpenv + | [ty] -> let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty in [ty], tpenv | ty :: args -> - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty let args = List.map SynTupleTypeSegment.Type args let tys, tpenv = TcTypesAsTuple cenv newOk checkConstraints occ env tpenv args m ty :: tys, tpenv @@ -4887,10 +4959,10 @@ and TcMeasuresAsTuple cenv newOk checkConstraints occ env (tpenv: UnscopedTyparE and TcTypesOrMeasures optKinds cenv newOk checkConstraints occ env tpenv args m = match optKinds with | None -> - List.mapFold (TcTypeOrMeasure None cenv newOk checkConstraints occ env) tpenv args + List.mapFold (TcTypeOrMeasure None cenv newOk checkConstraints occ WarnOnIWSAM.Yes env) tpenv args | Some kinds -> if List.length kinds = List.length args then - List.mapFold (fun tpenv (arg, kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkConstraints occ env tpenv arg) tpenv (List.zip args kinds) + List.mapFold (fun tpenv (arg, kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv arg) tpenv (List.zip args kinds) elif isNil kinds then error(Error(FSComp.SR.tcUnexpectedTypeArguments(), m)) else error(Error(FSComp.SR.tcTypeParameterArityMismatch((List.length kinds), (List.length args)), m)) @@ -5122,15 +5194,15 @@ and TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref pathTypeArgs (sy if checkConstraints = CheckCxs then List.iter2 (UnifyTypes cenv env m) tinst actualArgTys - // Try to decode System.Tuple --> F~ tuple types etc. + // Try to decode System.Tuple --> F# tuple types etc. let ty = g.decompileType tcref actualArgTys ty, tpenv -and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ env tpenv ty = +and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ iwsam env tpenv ty = let g = cenv.g try - TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env tpenv ty + TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ iwsam env tpenv ty with e -> errorRecovery e ty.Range @@ -5143,10 +5215,10 @@ and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ env tpenv recoveryTy, tpenv -and TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty = - TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkConstraints occ env tpenv ty +and TcTypeAndRecover cenv newOk checkConstraints occ iwsam env tpenv ty = + TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkConstraints occ iwsam env tpenv ty -and TcNestedTypeApplication cenv newOk checkConstraints occ env tpenv mWholeTypeApp ty pathTypeArgs tyargs = +and TcNestedTypeApplication cenv newOk checkConstraints occ iwsam env tpenv mWholeTypeApp ty pathTypeArgs tyargs = let g = cenv.g let ty = convertToTypeWithMetadataIfPossible g ty @@ -5156,6 +5228,7 @@ and TcNestedTypeApplication cenv newOk checkConstraints occ env tpenv mWholeType match ty with | TType_app(tcref, _, _) -> + CheckIWSAM cenv env checkConstraints iwsam mWholeTypeApp tcref TcTypeApp cenv newOk checkConstraints occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -5498,6 +5571,17 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = warning(Error(FSComp.SR.tcIndexNotationDeprecated(), mDot)) TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv (Some (expr3, mOfLeftOfSet)) expr1 indexArgs delayed + // Part of 'T.Ident + | SynExpr.Typar (typar, m) -> + TcTyparExprThen cenv overallTy env tpenv typar m delayed + + // ^expr + | SynExpr.IndexFromEnd (rightExpr, m) -> + errorR(Error(FSComp.SR.tcTraitInvocationShouldUseTick(), m)) + // Incorporate the '^' into the rightExpr, producing a nested SynExpr.Typar + let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr + TcExprThen cenv overallTy env tpenv isArg adjustedExpr delayed + | _ -> match delayed with | [] -> TcExprUndelayed cenv overallTy env tpenv synExpr @@ -5680,8 +5764,16 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = let env = ShrinkContext env mWholeExprIncludingParentheses expr2.Range TcExpr cenv overallTy env tpenv expr2 - | SynExpr.DotIndexedGet _ | SynExpr.DotIndexedSet _ - | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ | SynExpr.App _ | SynExpr.Dynamic _ | SynExpr.DotGet _ -> error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) + | SynExpr.DotIndexedGet _ + | SynExpr.DotIndexedSet _ + | SynExpr.Typar _ + | SynExpr.TypeApp _ + | SynExpr.Ident _ + | SynExpr.LongIdent _ + | SynExpr.App _ + | SynExpr.Dynamic _ + | SynExpr.DotGet _ -> + error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) | SynExpr.Const (SynConst.String (s, _, m), _) -> TcNonControlFlowExpr env <| fun env -> @@ -5768,7 +5860,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = TcExprArrayOrList cenv overallTy env tpenv (isArray, args, m) | SynExpr.New (superInit, synObjTy, arg, mNewExpr) -> - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes env tpenv synObjTy TcNonControlFlowExpr env <| fun env -> TcPropagatingExprLeafThenConvert cenv overallTy objTy env (* true *) mNewExpr (fun () -> @@ -5918,7 +6010,15 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.MatchBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - | SynExpr.IndexFromEnd (range=m) + // Part of 'T.Ident + | SynExpr.Typar (typar, m) -> + TcTyparExprThen cenv overallTy env tpenv typar m [] + + | SynExpr.IndexFromEnd (rightExpr, m) -> + errorR(Error(FSComp.SR.tcTraitInvocationShouldUseTick(), m)) + let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr + TcExprUndelayed cenv overallTy env tpenv adjustedExpr + | SynExpr.IndexRange (range=m) -> error(Error(FSComp.SR.tcInvalidIndexerExpression(), m)) @@ -5951,7 +6051,7 @@ and TcExprMatchLambda cenv overallTy env tpenv (isExnMatch, mArg, clauses, spMat overallExpr, tpenv and TcExprTypeAnnotated cenv overallTy env tpenv (synBodyExpr, synType, m) = - let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType UnifyOverallType cenv env m overallTy tgtTy let bodyExpr, tpenv = TcExpr cenv (MustConvertTo (false, tgtTy)) env tpenv synBodyExpr let bodyExpr2 = TcAdjustExprForTypeDirectedConversions cenv overallTy tgtTy env m bodyExpr @@ -5961,7 +6061,7 @@ and TcExprTypeTest cenv overallTy env tpenv (synInnerExpr, tgtTy, m) = let g = cenv.g let innerExpr, srcTy, tpenv = TcExprOfUnknownType cenv env tpenv synInnerExpr UnifyTypes cenv env m overallTy.Commit g.bool_ty - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy TcRuntimeTypeTest false true cenv env.DisplayEnv m tgtTy srcTy let expr = mkCallTypeTest g m tgtTy innerExpr expr, tpenv @@ -5971,7 +6071,7 @@ and TcExprUpcast cenv overallTy env tpenv (synExpr, synInnerExpr, m) = let tgtTy, tpenv = match synExpr with | SynExpr.Upcast (_, tgtTy, m) -> - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy UnifyTypes cenv env m tgtTy overallTy.Commit tgtTy, tpenv | SynExpr.InferredUpcast _ -> @@ -5989,7 +6089,7 @@ and TcExprDowncast cenv overallTy env tpenv (synExpr, synInnerExpr, m) = let tgtTy, tpenv, isOperator = match synExpr with | SynExpr.Downcast (_, tgtTy, m) -> - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy UnifyTypes cenv env m tgtTy overallTy.Commit tgtTy, tpenv, true | SynExpr.InferredDowncast _ -> overallTy.Commit, tpenv, false @@ -6071,13 +6171,13 @@ and TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImp let mObjTy = synObjTy.Range - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synObjTy // Work out the type of any interfaces to implement let extraImpls, tpenv = (tpenv, extraImpls) ||> List.mapFold (fun tpenv (SynInterfaceImpl(synIntfTy, _mWith, bindings, members, m)) -> let overrides = unionBindingAndMembers bindings members - let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy + let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synIntfTy if not (isInterfaceTy g intfTy) then error(Error(FSComp.SR.tcExpectedInterfaceType(), m)) if isErasedType g intfTy then @@ -6248,16 +6348,15 @@ and TcExprNamedIndexPropertySet cenv overallTy env tpenv (synLongId, synExpr1, s [ DelayedApp(ExprAtomicFlag.Atomic, false, None, synExpr1, mStmt) MakeDelayedSet(synExpr2, mStmt) ] -and TcExprTraitCall cenv overallTy env tpenv (tps, synMemberSig, arg, m) = +and TcExprTraitCall cenv overallTy env tpenv (synTypes, synMemberSig, arg, m) = let g = cenv.g TcNonPropagatingExprLeafThenConvert cenv overallTy env m (fun () -> - let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, m)) let traitInfo, tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv synMemberSig m - if BakedInTraitConstraintNames.Contains traitInfo.MemberName then - warning(BakedInMemberConstraintName(traitInfo.MemberName, m)) + if BakedInTraitConstraintNames.Contains traitInfo.MemberLogicalName then + warning(BakedInMemberConstraintName(traitInfo.MemberLogicalName, m)) - let argTys = traitInfo.ArgumentTypes - let returnTy = GetFSharpViewOfReturnType g traitInfo.ReturnType + let argTys = traitInfo.CompiledObjectAndArgumentTypes + let returnTy = traitInfo.GetReturnType g let args, namedCallerArgs = GetMethodArgs arg if not (isNil namedCallerArgs) then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(), m)) // Subsumption at trait calls if arguments have nominal type prior to unification of any arguments or return type @@ -6297,11 +6396,11 @@ and TcExprILAssembly cenv overallTy env tpenv (ilInstrs, synTyArgs, synArgs, syn let g = cenv.g let ilInstrs = (ilInstrs :?> ILInstr[]) let argTys = NewInferenceTypes g synArgs - let tyargs, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synTyArgs + let tyargs, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synTyArgs // No subsumption at uses of IL assembly code let flexes = argTys |> List.map (fun _ -> false) let args, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys synArgs - let retTys, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synRetTys + let retTys, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synRetTys let returnTy = match retTys with | [] -> g.unit_ty @@ -6373,26 +6472,57 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> TcExpr cenv overallTy env tpenv e) -and (|IndexArgOptionalFromEnd|) indexArg = +and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = + match delayed with + //'T .Ident + //^T .Ident (args) .. + | DelayedDotLookup (ident :: rest, m2) :: delayed2 -> + let ad = env.eAccessRights + let tp, tpenv = TcTypar cenv env NoNewTypars tpenv synTypar + let mExprAndLongId = unionRanges synTypar.Range ident.idRange + let ty = mkTyparTy tp + let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr ident.idRange ad ident IgnoreOverrides TypeNameResolutionInfo.Default ty + let delayed3 = + match rest with + | [] -> delayed2 + | _ -> DelayedDotLookup (rest, m2) :: delayed2 + CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) + TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed3 + //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution + | _ -> + let (SynTypar(_, q, _)) = synTypar + let msg = + match q with + | TyparStaticReq.None -> FSComp.SR.parsIncompleteTyparExpr1() + | TyparStaticReq.HeadType -> FSComp.SR.parsIncompleteTyparExpr2() + error (Error(msg, m)) + +and (|IndexArgOptionalFromEnd|) (cenv: cenv) indexArg = match indexArg with - | SynExpr.IndexFromEnd (a, m) -> (a, true, m) + | SynExpr.IndexFromEnd (a, m) -> + if not (cenv.g.langVersion.SupportsFeature LanguageFeature.FromEndSlicing) then + errorR (Error(FSComp.SR.fromEndSlicingRequiresVFive(), m)) + (a, true, m) | _ -> (indexArg, false, indexArg.Range) -and DecodeIndexArg indexArg = +and DecodeIndexArg cenv indexArg = match indexArg with | SynExpr.IndexRange (info1, _opm, info2, m1, m2, _) -> let info1 = match info1 with - | Some (IndexArgOptionalFromEnd (expr1, isFromEnd1, _)) -> Some (expr1, isFromEnd1) + | Some (IndexArgOptionalFromEnd cenv (expr1, isFromEnd1, _)) -> Some (expr1, isFromEnd1) | None -> None let info2 = match info2 with - | Some (IndexArgOptionalFromEnd (synExpr2, isFromEnd2, _)) -> Some (synExpr2, isFromEnd2) + | Some (IndexArgOptionalFromEnd cenv (synExpr2, isFromEnd2, _)) -> Some (synExpr2, isFromEnd2) | None -> None IndexArgRange (info1, info2, m1, m2) - | IndexArgOptionalFromEnd (expr, isFromEnd, m) -> + | IndexArgOptionalFromEnd cenv (expr, isFromEnd, m) -> IndexArgItem(expr, isFromEnd, m) +and DecodeIndexArgs cenv indexArgs = + indexArgs |> List.map (DecodeIndexArg cenv) + and (|IndexerArgs|) expr = match expr with | SynExpr.Tuple (false, argExprs, _, _) -> argExprs @@ -6400,11 +6530,11 @@ and (|IndexerArgs|) expr = and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv (setInfo: _ option) synLeftExpr indexArgs delayed = let leftExpr, leftExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synLeftExpr - let expandedIndexArgs = ExpandIndexArgs (Some synLeftExpr) indexArgs + let expandedIndexArgs = ExpandIndexArgs cenv (Some synLeftExpr) indexArgs TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo (Some synLeftExpr) leftExpr leftExprTy expandedIndexArgs indexArgs delayed // Eliminate GetReverseIndex from index args -and ExpandIndexArgs (synLeftExprOpt: SynExpr option) indexArgs = +and ExpandIndexArgs cenv (synLeftExprOpt: SynExpr option) indexArgs = // xs.GetReverseIndex rank offset - 1 let rewriteReverseExpr (rank: int) (offset: SynExpr) (range: range) = @@ -6429,7 +6559,7 @@ and ExpandIndexArgs (synLeftExprOpt: SynExpr option) indexArgs = let expandedIndexArgs = indexArgs |> List.mapi ( fun pos indexerArg -> - match DecodeIndexArg indexerArg with + match DecodeIndexArg cenv indexerArg with | IndexArgItem(expr, fromEnd, range) -> [ if fromEnd then rewriteReverseExpr pos expr range else expr ] | IndexArgRange(info1, info2, range1, range2) -> @@ -6461,7 +6591,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO // Find the first type in the effective hierarchy that either has a DefaultMember attribute OR // has a member called 'Item' - let isIndex = indexArgs |> List.forall (fun indexArg -> match DecodeIndexArg indexArg with IndexArgItem _ -> true | _ -> false) + let isIndex = indexArgs |> List.forall (fun indexArg -> match DecodeIndexArg cenv indexArg with IndexArgItem _ -> true | _ -> false) let propName = if isIndex then FoldPrimaryHierarchyOfType (fun ty acc -> @@ -6492,7 +6622,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let idxRange = indexArgs |> List.map (fun e -> e.Range) |> List.reduce unionRanges let MakeIndexParam setSliceArrayOption = - match List.map DecodeIndexArg indexArgs with + match DecodeIndexArgs cenv indexArgs with | [] -> failwith "unexpected empty index list" | [IndexArgItem _] -> SynExpr.Paren (expandedIndexArgs.Head, range0, None, idxRange) | _ -> SynExpr.Paren (SynExpr.Tuple (false, expandedIndexArgs @ Option.toList setSliceArrayOption, [], idxRange), range0, None, idxRange) @@ -6504,7 +6634,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let info = if isArray then let fixedIndex3d4dEnabled = g.langVersion.SupportsFeature LanguageFeature.FixedIndexSlice3d4d - let indexArgs = List.map DecodeIndexArg indexArgs + let indexArgs = List.map (DecodeIndexArg cenv) indexArgs match indexArgs, setInfo with | [IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray2D", expandedIndexArgs) | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], None -> Some (indexOpPath, "GetArray3D", expandedIndexArgs) @@ -6572,7 +6702,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | _ -> None elif isString then - match List.map DecodeIndexArg indexArgs, setInfo with + match DecodeIndexArgs cenv indexArgs, setInfo with | [IndexArgRange _], None -> Some (sliceOpPath, "GetStringSlice", expandedIndexArgs) | [IndexArgItem _], None -> Some (indexOpPath, "GetString", expandedIndexArgs) | _ -> None @@ -6675,7 +6805,7 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite | Some mObjTy, None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos | None, _ -> AfterResolution.DoNothing - TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed + TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed | Item.DelegateCtor ty, [arg] -> // Re-record the name resolution since we now know it's a constructor call @@ -7068,7 +7198,7 @@ and TcObjectExpr cenv env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mO let afterResolution = ForNewConstructors cenv.tcSink env mObjTy methodName minfos let ad = env.AccessRights - let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] + let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] // The 'base' value is always bound let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some id) expr, baseIdOpt, tpenv @@ -7344,7 +7474,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let tyExprs = percentATys |> Array.map (mkCallTypeOf g m) |> Array.toList mkArray (g.system_Type_ty, tyExprs, m) - let fmtExpr = MakeMethInfoCall cenv.amap m newFormatMethod [] [mkString g m printfFormatString; argsExpr; percentATysExpr] + let fmtExpr = MakeMethInfoCall cenv.amap m newFormatMethod [] [mkString g m printfFormatString; argsExpr; percentATysExpr] None if isString then TcPropagatingExprLeafThenConvert cenv overallTy g.string_ty env (* true *) m (fun () -> @@ -7367,7 +7497,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m) // FormattableString are *always* turned into FormattableStringFactory.Create calls, boxing each argument - let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] + let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] None let resultExpr = if typeEquiv g overallTy.Commit g.system_IFormattable_ty then @@ -7785,13 +7915,13 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s let bodyExprFixup elemVar bodyExpr = let elemAddrVar, _ = mkCompGenLocal mIn "addr" elemAddrTy let e = mkInvisibleLet mIn elemVar (mkAddrGet mIn (mkLocalValRef elemAddrVar)) bodyExpr - let getItemCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ] + let getItemCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ] None mkInvisibleLet mIn elemAddrVar getItemCallExpr e // Evaluate the span expression once and put it in spanVar let overallExprFixup overallExpr = mkLet spForBind mFor spanVar enumExpr overallExpr - let getLengthCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] + let getLengthCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] None // Ask for a loop over integers for the given range (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero g mFor, mkDecr g mFor getLengthCallExpr)) @@ -7939,7 +8069,7 @@ and Propagate cenv (overallTy: OverallTy) (env: TcEnv) tpenv (expr: ApplicableEx // See RFC FS-1053.md let isAddrOf = match expr with - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _) + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)) when (valRefEq g vref g.addrof_vref || valRefEq g vref g.nativeptr_tobyref_vref) -> true | _ -> false @@ -8113,7 +8243,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = | Item.FakeInterfaceCtor _ -> false | _ -> true) -> let overallTy = match overallTyOpt with None -> MustEqual (NewInferenceType g) | Some t -> t - let _, _ = TcItemThen cenv overallTy env tpenv res delayed + let _, _ = TcItemThen cenv overallTy env tpenv res None delayed true | _ -> false @@ -8168,7 +8298,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = // expr : type" allowed with no subsequent qualifications | SynExpr.Typed (synBodyExpr, synType, _) when delayed.IsEmpty && overallTyOpt.IsNone -> - let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType check (Some (MustEqual tgtTy)) resultOpt synBodyExpr delayed | _ -> @@ -8230,9 +8360,9 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE | _ -> () match leftExpr with - | ApplicableExpr(_, NameOfExpr g _, _) when g.langVersion.SupportsFeature LanguageFeature.NameOf -> + | ApplicableExpr(expr=NameOfExpr g _) when g.langVersion.SupportsFeature LanguageFeature.NameOf -> let replacementExpr = TcNameOfExpr cenv env tpenv synArg - TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true)) g.string_ty ExprAtomicFlag.Atomic delayed + TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true, None)) g.string_ty ExprAtomicFlag.Atomic delayed | _ -> // Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library. // Set a flag in the syntax tree to say we noticed a leading 'seq' @@ -8243,7 +8373,7 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE match synArg with | SynExpr.ComputationExpr (false, comp, m) when (match leftExpr with - | ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [SeqExpr g], _), _) -> true + | ApplicableExpr(expr=Expr.Op(TOp.Coerce, _, [SeqExpr g], _)) -> true | _ -> false) -> SynExpr.ComputationExpr (true, comp, m) | _ -> synArg @@ -8254,8 +8384,8 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE // will have debug points on "f expr1" and "g expr2" let env = match leftExpr with - | ApplicableExpr(_, Expr.Val (vref, _, _), _) - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [_], _), _) + | ApplicableExpr(expr=Expr.Val (vref, _, _)) + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [_], _)) when valRefEq g vref g.and_vref || valRefEq g vref g.and2_vref || valRefEq g vref g.or_vref @@ -8279,7 +8409,7 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot -> - let expandedIndexArgs = ExpandIndexArgs synLeftExprOpt indexArgs + let expandedIndexArgs = ExpandIndexArgs cenv synLeftExprOpt indexArgs let setInfo, delayed = match delayed with | DelayedSet(expr3, _) :: rest -> Some (expr3, unionRanges leftExpr.Range synArg.Range), rest @@ -8321,14 +8451,14 @@ and TcLongIdentThen cenv (overallTy: OverallTy) env tpenv (SynLongIdent(longId, let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId |> ForceRaise - TcItemThen cenv overallTy env tpenv nameResolutionResult delayed + TcItemThen cenv overallTy env tpenv nameResolutionResult None delayed //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) delayed = +and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) staticTyOpt delayed = let delayed = delayRest rest mItem delayed match item with // x where x is a union case or active pattern result tag. @@ -8339,7 +8469,10 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed | Item.MethodGroup (methodName, minfos, _) -> - TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed + TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed + + | Item.Trait traitInfo -> + TcTraitItemThen cenv overallTy env None traitInfo tpenv mItem delayed | Item.CtorGroup(nm, minfos) -> TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed @@ -8357,7 +8490,7 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed | Item.Property (nm, pinfos) -> - TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed + TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution staticTyOpt delayed | Item.ILField finfo -> TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed @@ -8375,7 +8508,19 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItem)) | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) - | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) + // These items are not expected here - they are only used for reporting symbols from name resolution to language service + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.CustomBuilder _ + | Item.ModuleOrNamespaces _ + | Item.NewDef _ + | Item.SetterArg _ + | Item.TypeVar _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Types(_, []) -> + error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) /// Type check the application of a union case. Also used to cover constructions of F# exception values, and /// applications of active pattern result labels. @@ -8537,18 +8682,18 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS 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 - TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed + TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) None otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -8561,13 +8706,13 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = // call to ResolveLongIdentAsExprAndComputeRange error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) -and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed = +and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed = let ad = env.eAccessRights // Static method calls Type.Foo(arg1, ..., argn) let meths = List.map (fun minfo -> minfo, None) minfos match delayed with | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> @@ -8581,9 +8726,9 @@ and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem after match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | None -> #endif @@ -8597,16 +8742,16 @@ and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem after match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | _ -> #if !NO_TYPEPROVIDERS if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed = #if !NO_TYPEPROVIDERS @@ -8625,7 +8770,7 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_TYPEPROVIDERS @@ -8646,7 +8791,7 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -8659,6 +8804,68 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) +and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = + let g = cenv.g + + let argTys = traitInfo.GetLogicalArgumentTypes(g) + let retTy = traitInfo.GetReturnType(g) + + match traitInfo.SupportTypes with + | tys when tys.Length > 1 -> + error(Error (FSComp.SR.tcTraitHasMultipleSupportTypes(traitInfo.MemberDisplayNameCore), mItem)) + | _ -> () + + match objOpt, traitInfo.MemberFlags.IsInstance with + | Some _, false -> error (Error (FSComp.SR.tcTraitIsStatic traitInfo.MemberDisplayNameCore, mItem)) + | None, true -> error (Error (FSComp.SR.tcTraitIsNotStatic traitInfo.MemberDisplayNameCore, mItem)) + | _ -> () + + // If this is an instance trait the object must be evaluated, just in case this is a first-class use of the trait, e.g. + // (Compute()).SomeMethod --> + // let obj = Compute() in (fun arg -> SomeMethod(arg)) + // (Compute()).SomeMethod(3) --> + // let obj = Compute() in (fun arg -> SomeMethod(arg)) 3 + let wrapper, objArgs = + match argTys with + | [] -> + id, Option.toList objOpt + | _ -> + match objOpt with + | None -> + id, [] + | Some objExpr -> + // Evaluate the object first + let objVal, objValExpr = mkCompGenLocal mItem "obj" (tyOfExpr g objExpr) + mkCompGenLet mItem objVal objExpr, [objValExpr] + + // Build a lambda for the trait call + let applicableExpr, exprTy = + // Empty arguments indicates a non-indexer property constraint + match argTys with + | [] -> + let expr = Expr.Op (TOp.TraitCall traitInfo, [], objArgs, mItem) + let exprTy = tyOfExpr g expr + let applicableExpr = MakeApplicableExprNoFlex cenv expr + applicableExpr, exprTy + | _ -> + let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let traitCall = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@ves, mItem) + let v, body = MultiLambdaToTupledLambda g vs traitCall + let expr = mkLambda mItem v (body, retTy) + let exprTy = tyOfExpr g expr + let applicableExpr = MakeApplicableExprForTraitCall cenv expr (vs, traitCall) + applicableExpr, exprTy + + // Propagate the types from the known application structure + + Propagate cenv overallTy env tpenv applicableExpr exprTy delayed + + // Check and apply the arguments + let resExpr, tpenv = TcDelayed cenv overallTy env tpenv mItem applicableExpr exprTy ExprAtomicFlag.NonAtomic delayed + + // Aply the wrapper to pre-evaluate the object if any + wrapper resExpr, tpenv + and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = let g = cenv.g let isPrefix = IsLogicalPrefixOperator id.idText @@ -8666,16 +8873,16 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = let argData = if isPrefix then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] elif isTernary then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] else - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] - let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) let argTypars = argData |> List.map (fun d -> Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, d, false, TyparDynamicReq.Yes, [], false, false)) let retTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, retTyData, false, TyparDynamicReq.Yes, [], false, false) let argTys = argTypars |> List.map mkTyparTy @@ -8710,6 +8917,7 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.Const _ + | SynExpr.Typar _ | SynExpr.LongIdent _ | SynExpr.Dynamic _ -> true @@ -8787,7 +8995,7 @@ and TcDelegateCtorItemThen cenv overallTy env ty tinstEnclosing tpenv mItem dela | DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs) :: DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -8859,7 +9067,7 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vExpr else MakeApplicableExprWithFlex cenv env vExpr) PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed -and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed = +and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution staticTyOpt delayed = let g = cenv.g let ad = env.eAccessRights @@ -8897,19 +9105,19 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed else let args = if pinfo.IsIndexer then args else [] if isNil meths then errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed and TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed = let g = cenv.g @@ -9023,9 +9231,14 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight g false objExprTy) let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad 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 = + let g = cenv.g + let ad = env.eAccessRights + let objArgs = [objExpr] let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed - match item with | Item.MethodGroup (methodName, minfos, _) -> let atomicFlag, tyArgsOpt, args, delayed, tpenv = GetSynMemberApplicationArgs delayed tpenv @@ -9043,7 +9256,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) - TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed | None -> if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) @@ -9052,7 +9265,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let tyArgsOpt, tpenv = TcMemberTyArgsOpt cenv env tpenv tyArgsOpt let meths = minfos |> List.map (fun minfo -> minfo, None) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed | Item.Property (nm, pinfos) -> // Instance property @@ -9080,7 +9293,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed else if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly then @@ -9088,12 +9301,12 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let args = if pinfo.IsIndexer then args else [] let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed | Item.RecdField rfinfo -> // Get or set instance F# field or literal @@ -9152,8 +9365,31 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Instance IL event (fake up event-as-value) TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr, objExprTy)) einfo delayed + | Item.Trait traitInfo -> + TcTraitItemThen cenv overallTy env (Some objExpr) traitInfo tpenv mItem delayed + | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ -> error (Error (FSComp.SR.tcConstructorsCannotBeFirstClassValues(), mItem)) - | _ -> error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) + + // These items are not expected here - they can't be the result of a instance member dot-lookup "expr.Ident" + | Item.ActivePatternResult _ + | Item.CustomOperation _ + | Item.CtorGroup _ + | Item.ExnCase _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.TypeVar _ + | Item.Types _ + | Item.UnionCase _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Value _ + // These items are not expected here - they are only used for reporting symbols from name resolution to language service + | Item.NewDef _ + | Item.SetterArg _ + | Item.CustomBuilder _ + | Item.ArgName _ + | Item.ActivePatternCase _ -> + error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) // Instance IL event (fake up event-as-value) and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einfo: EventInfo) delayed = @@ -9189,10 +9425,10 @@ and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einf // EventHelper ((fun d -> e.add_X(d)), (fun d -> e.remove_X(d)), (fun f -> new 'Delegate(f))) mkCallCreateEvent g mItem delTy argsTy (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy - let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.AddMethod NormalValUse [] objVars [de] + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.AddMethod NormalValUse [] objVars [de] None mkLambda mItem dv (callExpr, g.unit_ty)) (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy - let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] None 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 @@ -9229,6 +9465,7 @@ and TcMethodApplicationThen isSuperInit // is this a special invocation, e.g. a super-class constructor call. Passed through to BuildMethodCall args // the _syntactic_ method arguments, not yet type checked. atomicFlag // is the expression atomic or not? + staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed // further lookups and applications that follow this = @@ -9243,7 +9480,7 @@ and TcMethodApplicationThen // Call the helper below to do the real checking let (expr, attributeAssignedNamedItems, delayed), tpenv = - TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy delayed + TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed // Give errors if some things couldn't be assigned if not (isNil attributeAssignedNamedItems) then @@ -9278,7 +9515,8 @@ and CalledMethHasSingleArgumentGroupOfThisLength n (calledMeth: MethInfo) = | [argAttribs] -> argAttribs = n | _ -> false -and isSimpleFormalArg (isParamArrayArg, _isInArg, isOutArg, optArgInfo: OptionalArgInfo, callerInfo: CallerInfo, _reflArgInfo: ReflectedArgInfo) = +and isSimpleFormalArg info = + let (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _reflArgInfo)) = info not isParamArrayArg && not isOutArg && not optArgInfo.IsOptional && callerInfo = NoCallerInfo and GenerateMatchingSimpleArgumentTypes cenv (calledMeth: MethInfo) mItem = @@ -9399,7 +9637,8 @@ and TcMethodApplication_UniqueOverloadInference candidateMethsAndProps candidates mMethExpr - mItem = + mItem + staticTyOpt = let g = cenv.g let denv = env.DisplayEnv @@ -9457,7 +9696,7 @@ and TcMethodApplication_UniqueOverloadInference 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) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt) let preArgumentTypeCheckingCalledMethGroup = [ for minfo, pinfoOpt in candidateMethsAndProps do @@ -9599,6 +9838,7 @@ and TcMethodApplication isSuperInit curriedCallerArgs (exprTy: OverallTy) + staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed = @@ -9637,7 +9877,7 @@ and TcMethodApplication // Extract what we know about the caller arguments, either type-directed if // no arguments are given or else based on the syntax of the arguments. let uniquelyResolved, preArgumentTypeCheckingCalledMethGroup = - TcMethodApplication_UniqueOverloadInference cenv env exprTy tyArgsOpt ad objTyOpt isCheckingAttributeCall callerObjArgTys methodName curriedCallerArgsOpt candidateMethsAndProps candidates mMethExpr mItem + TcMethodApplication_UniqueOverloadInference cenv env exprTy tyArgsOpt ad objTyOpt isCheckingAttributeCall callerObjArgTys methodName curriedCallerArgsOpt candidateMethsAndProps candidates mMethExpr mItem staticTyOpt // STEP 2. Check arguments let unnamedCurriedCallerArgs, namedCurriedCallerArgs, lambdaVars, returnTy, tpenv = @@ -9668,7 +9908,7 @@ 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)) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, 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. @@ -9763,7 +10003,7 @@ and TcMethodApplication /// STEP 6. Build the call expression, then adjust for byref-returns, out-parameters-as-tuples, post-hoc property assignments, methods-as-first-class-value, let callExpr0, exprTy = - BuildPossiblyConditionalMethodCall cenv env mut mMethExpr isProp finalCalledMethInfo isSuperInit finalCalledMethInst objArgs allArgsCoerced + BuildPossiblyConditionalMethodCall cenv env mut mMethExpr isProp finalCalledMethInfo isSuperInit finalCalledMethInst objArgs allArgsCoerced staticTyOpt // Handle byref returns let callExpr1, exprTy = @@ -9855,15 +10095,17 @@ and TcMethodApplication (callExpr6, finalAttributeAssignedNamedItems, delayed), tpenv /// For Method(X = expr) 'X' can be a property, IL Field or F# record field -and TcSetterArgExpr cenv env denv objExpr ad (AssignedItemSetter(id, setter, CallerArg(callerArgTy, m, isOptCallerArg, argExpr))) calledFromConstructor = +and TcSetterArgExpr cenv env denv objExpr ad assignedSetter calledFromConstructor = let g = cenv.g + let (AssignedItemSetter(id, setter, callerArg)) = assignedSetter + let (CallerArg(callerArgTy, m, isOptCallerArg, argExpr)) = callerArg if isOptCallerArg then error(Error(FSComp.SR.tcInvalidOptionalAssignmentToPropertyOrField(), m)) let argExprPrebinder, action, defnItem = match setter with - | AssignedPropSetter (pinfo, pminfo, pminst) -> + | AssignedPropSetter (propStaticTyOpt, pinfo, pminfo, pminst) -> if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly && not calledFromConstructor then errorR (Error (FSComp.SR.tcInitOnlyPropertyCannotBeSet1 pinfo.PropertyName, m)) @@ -9873,7 +10115,7 @@ and TcSetterArgExpr cenv env denv objExpr ad (AssignedItemSetter(id, setter, Cal let tcVal = LightweightTcValForUsingInBuildMethodCall g let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap 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] |> fst + let action = BuildPossiblyConditionalMethodCall cenv env mut m true pminfo NormalValUse pminst [objExpr] [argExpr] propStaticTyOpt |> fst argExprPrebinder, action, Item.Property (pinfo.PropertyName, [pinfo]) | AssignedILFieldSetter finfo -> @@ -10160,7 +10402,7 @@ and TcStaticOptimizationConstraint cenv env tpenv c = | SynStaticOptimizationConstraint.WhenTyparTyconEqualsTycon(tp, ty, m) -> if not g.compilingFSharpCore then errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(), m)) - let tyR, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let tpR, tpenv = TcTypar cenv env NewTyparsOK tpenv tp TTyconEqualsTycon(mkTyparTy tpR, tyR), tpenv | SynStaticOptimizationConstraint.WhenTyparIsStruct(tp, m) -> @@ -10539,7 +10781,7 @@ and TcBindingTyparDecls alwaysRigid cenv env tpenv (ValTyparDecls(synTypars, syn declaredTypars |> List.iter (fun tp -> SetTyparRigid env.DisplayEnv tp.Range tp) declaredTypars else - let rigidCopyOfDeclaredTypars = copyTypars declaredTypars + let rigidCopyOfDeclaredTypars = copyTypars false declaredTypars // The type parameters used to check rigidity after inference are marked rigid straight away rigidCopyOfDeclaredTypars |> List.iter (fun tp -> SetTyparRigid env.DisplayEnv tp.Range tp) // The type parameters using during inference will be marked rigid after inference @@ -10584,7 +10826,7 @@ and TcAttributeEx canFail cenv (env: TcEnv) attrTgt attrEx (synAttr: SynAttribut let ad = env.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze err - | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(SynLongIdent(tycon, [], List.replicate tycon.Length None)), None, [], [], None, false, mAttr)) ) + | _ -> 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))) let ad = env.eAccessRights @@ -10671,7 +10913,7 @@ and TcAttributeEx canFail cenv (env: TcEnv) attrTgt attrEx (synAttr: SynAttribut let meths = minfos |> List.map (fun minfo -> minfo, None) let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos let (expr, attributeAssignedNamedItems, _), _ = - TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) [] + TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) None [] UnifyTypes cenv env mAttr ty (tyOfExpr g expr) @@ -10959,7 +11201,7 @@ and ApplyTypesFromArgumentPatterns (cenv, env, optionalArgsOK, ty, m, tpenv, Nor match retInfoOpt with | None -> () | Some (SynBindingReturnInfo (retInfoTy, m, _)) -> - let retInfoTy, _ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv retInfoTy + let retInfoTy, _ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv retInfoTy UnifyTypes cenv env m ty retInfoTy // Property setters always have "unit" return type match memberFlagsOpt with @@ -10984,7 +11226,7 @@ and ComputeIsComplete enclosingDeclaredTypars declaredTypars ty = /// Determine if a uniquely-identified-abstract-slot exists for an override member (or interface member implementation) based on the information available /// at the syntactic definition of the member (i.e. prior to type inference). If so, we know the expected signature of the override, and the full slotsig /// it implements. Apply the inferred slotsig. -and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = +and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = let g = cenv.g let ad = envinner.eAccessRights @@ -11013,7 +11255,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn match memberFlags.MemberKind with | SynMemberKind.Member -> let dispatchSlots, dispatchSlotsArityMatch = - GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData) + GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData, memberFlags) let uniqueAbstractMethSigs = match dispatchSlots with @@ -11047,7 +11289,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn let absSlotTy = mkMethodTy g argTysFromAbsSlot retTyFromAbsSlot - UnifyTypes cenv envinner m bindingTy absSlotTy + UnifyTypes cenv envinner m argsAndRetTy absSlotTy declaredTypars | _ -> declaredTypars @@ -11114,7 +11356,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn error(Error(FSComp.SR.tcInvalidSignatureForSet(), memberId.idRange)) mkFunTy g retTyFromAbsSlot g.unit_ty - UnifyTypes cenv envinner m bindingTy absSlotTy) + UnifyTypes cenv envinner m argsAndRetTy absSlotTy) // What's the type containing the abstract slot we're implementing? Used later on in MakeMemberDataAndMangledNameForMemberVal. // This type must be in terms of the enclosing type's formal type parameters, hence the application of revRenaming. @@ -11155,6 +11397,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl envinner: TcEnv, tpenv, declKind, + synTyparDecls, newslotsOK, overridesOK, tcrefContainerInfo, @@ -11162,7 +11405,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl id: Ident, vis2, declaredTypars, - memberFlagsOpt, + memberFlagsOpt: SynMemberFlags option, thisIdOpt, bindingAttribs, valSynInfo, @@ -11178,6 +11421,35 @@ and AnalyzeRecursiveStaticMemberOrValDecl // name for the member and the information about which type it is augmenting match tcrefContainerInfo, memberFlagsOpt with + | Some(MemberOrValContainerInfo(tcref, intfSlotTyOpt, _, _, declaredTyconTypars)), Some memberFlags + when (match memberFlags.MemberKind with + | SynMemberKind.Member -> true + | SynMemberKind.PropertyGet -> true + | SynMemberKind.PropertySet -> true + | SynMemberKind.PropertyGetSet -> true + | _ -> false) && + not memberFlags.IsInstance && + memberFlags.IsOverrideOrExplicitImpl -> + + CheckMemberFlags intfSlotTyOpt newslotsOK overridesOK memberFlags id.idRange + CheckForNonAbstractInterface declKind tcref memberFlags id.idRange + + let isExtrinsic = (declKind = ExtrinsicExtensionBinding) + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner + let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic + + let (ExplicitTyparInfo(_, declaredTypars, infer)) = explicitTyparInfo + + let optInferredImplSlotTys, declaredTypars = + ApplyAbstractSlotInference cenv envinner (ty, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + + let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) + + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, id, false) + + envinner, tpenv, id, None, Some memberInfo, vis, vis2, None, enclosingDeclaredTypars, None, explicitTyparInfo, bindingRhs, declaredTypars + | Some(MemberOrValContainerInfo(tcref, intfSlotTyOpt, baseValOpt, _safeInitInfo, declaredTyconTypars)), Some memberFlags -> assert (Option.isNone intfSlotTyOpt) @@ -11285,8 +11557,8 @@ and AnalyzeRecursiveInstanceMemberDecl let baseValOpt = if tcref.IsFSharpObjectModelTycon then baseValOpt else None // Apply the known type of 'this' - let bindingTy = NewInferenceType g - UnifyTypes cenv envinner mBinding ty (mkFunTy g thisTy bindingTy) + let argsAndRetTy = NewInferenceType g + UnifyTypes cenv envinner mBinding ty (mkFunTy g thisTy argsAndRetTy) CheckForNonAbstractInterface declKind tcref memberFlags memberId.idRange @@ -11294,7 +11566,7 @@ and AnalyzeRecursiveInstanceMemberDecl // at the member signature. If so, we know the type of this member, and the full slotsig // it implements. Apply the inferred slotsig. let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (bindingTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + ApplyAbstractSlotInference cenv envinner (argsAndRetTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) // Update the ExplicitTyparInfo to reflect the declaredTypars inferred from the abstract slot let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) @@ -11345,8 +11617,8 @@ and AnalyzeRecursiveDecl match pat with | SynPat.FromParseError(innerPat, _) -> analyzeRecursiveDeclPat tpenv innerPat | SynPat.Typed(innerPat, tgtTy, _) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType envinner tpenv tgtTy - UnifyTypes cenv envinner mBinding ty ctyR + let tgtTyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv tgtTy + UnifyTypes cenv envinner mBinding ty tgtTyR analyzeRecursiveDeclPat tpenv innerPat | SynPat.Attrib(_innerPat, _attribs, m) -> error(Error(FSComp.SR.tcAttributesInvalidInPatterns(), m)) @@ -11363,7 +11635,7 @@ and AnalyzeRecursiveDecl | SynPat.Named (SynIdent(id,_), _, vis2, _) -> AnalyzeRecursiveStaticMemberOrValDecl - (cenv, envinner, tpenv, declKind, + (cenv, envinner, tpenv, declKind, synTyparDecls, newslotsOK, overridesOK, tcrefContainerInfo, vis1, id, vis2, declaredTypars, memberFlagsOpt, thisIdOpt, bindingAttribs, diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 696e5d31932..f7a7fc217bd 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -489,6 +489,13 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +/// Indicates whether the position being checked is precisely the r.h.s. of a "'T :> ***" constraint or a similar +/// places where IWSAM types do not generate a warning +[] +type WarnOnIWSAM = + | Yes + | No + /// Indicates if a member binding is an object expression binding type IsObjExprBinding = | ObjExprBinding @@ -1065,6 +1072,7 @@ val TcType: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1077,6 +1085,7 @@ val TcTypeOrMeasureAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1088,6 +1097,7 @@ val TcTypeAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index 1334b1bf54c..31471ba32b2 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -16,25 +16,25 @@ open FSharp.Compiler.TcGlobals type FormatItem = Simple of TType | FuncAndVal -let copyAndFixupFormatTypar m tp = - let _,_,tinst = FreshenAndFixupTypars m TyparRigidity.Flexible [] [] [tp] +let copyAndFixupFormatTypar g m tp = + let _,_,tinst = FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] [tp] List.head tinst let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *) -let mkFlexibleFormatTypar m tys dfltTy = +let mkFlexibleFormatTypar g m tys dfltTy = let tp = Construct.NewTypar (TyparKind.Type, TyparRigidity.Rigid, SynTypar(mkSynId m "fmt",TyparStaticReq.HeadType,true),false,TyparDynamicReq.Yes,[],false,false) tp.SetConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dfltTy,m)] - copyAndFixupFormatTypar m tp + copyAndFixupFormatTypar g m tp let mkFlexibleIntFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.byte_ty; g.int16_ty; g.int32_ty; g.int64_ty; g.sbyte_ty; g.uint16_ty; g.uint32_ty; g.uint64_ty;g.nativeint_ty;g.unativeint_ty; ] g.int_ty + mkFlexibleFormatTypar g m [ g.byte_ty; g.int16_ty; g.int32_ty; g.int64_ty; g.sbyte_ty; g.uint16_ty; g.uint32_ty; g.uint64_ty;g.nativeint_ty;g.unativeint_ty; ] g.int_ty let mkFlexibleDecimalFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.decimal_ty ] g.decimal_ty + mkFlexibleFormatTypar g m [ g.decimal_ty ] g.decimal_ty let mkFlexibleFloatFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.float_ty; g.float32_ty; g.decimal_ty ] g.float_ty + mkFlexibleFormatTypar g m [ g.float_ty; g.float32_ty; g.decimal_ty ] g.float_ty type FormatInfoRegister = { mutable leftJustify : bool diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 7ced746b6a1..90695abf692 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -96,7 +96,7 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = id.idText, patEnvR | SynSimplePat.Typed (p, cty, m) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInType env tpenv cty + let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty match p with // Optional arguments on members @@ -166,7 +166,7 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS ps', patEnvR | SynSimplePats.Typed (p, cty, m) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty match p with // Solitary optional arguments on members @@ -277,7 +277,7 @@ and TcPat warnOnUpper (cenv: cenv) env valReprInfo vFlags (patEnv: TcPatLinearEn | SynPat.Typed (p, cty, m) -> let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv - let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty UnifyTypes cenv env m ty ctyR let patEnvR = TcPatLinearEnv(tpenvR, names, takenNames) TcPat warnOnUpper cenv env valReprInfo vFlags patEnvR ty p @@ -369,7 +369,7 @@ and TcPatNamed warnOnUpper cenv env vFlags patEnv id ty isMemberThis vis valRepr and TcPatIsInstance warnOnUpper cenv env valReprInfo vFlags patEnv srcTy synPat synTargetTy m = let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv - let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType env tpenv synTargetTy + let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synTargetTy TcRuntimeTypeTest false true cenv env.DisplayEnv m tgtTy srcTy let patEnv = TcPatLinearEnv(tpenv, names, takenNames) match synPat with diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index cb70cd5835e..77b3cb3486a 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -115,32 +115,37 @@ let NewByRefKindInferenceType (g: TcGlobals) m = let NewInferenceTypes g l = l |> List.map (fun _ -> NewInferenceType g) -// QUERY: should 'rigid' ever really be 'true'? We set this when we know +let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq + 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 m rigid fctps tinst tpsorig = - let copy_tyvar (tp: Typar) = NewCompGenTypar (tp.Kind, rigid, tp.StaticReq, (if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No), false) - let tps = tpsorig |> List.map copy_tyvar +let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = + let tps = tpsorig |> List.map (FreshenTypar g rigid) let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps tps, renaming, tinst -let FreshenTypeInst m tpsorig = - FreshenAndFixupTypars m TyparRigidity.Flexible [] [] tpsorig +let FreshenTypeInst g m tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig -let FreshMethInst m fctps tinst tpsorig = - FreshenAndFixupTypars m TyparRigidity.Flexible fctps tinst tpsorig +let FreshMethInst g m fctps tinst tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible fctps tinst tpsorig -let FreshenTypars m tpsorig = +let FreshenTypars g m tpsorig = match tpsorig with | [] -> [] | _ -> - let _, _, tpTys = FreshenTypeInst m tpsorig + let _, _, tpTys = FreshenTypeInst g m tpsorig tpTys let FreshenMethInfo m (minfo: MethInfo) = - let _, _, tpTys = FreshMethInst m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars + let _, _, tpTys = FreshMethInst minfo.TcGlobals m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars tpTys //------------------------------------------------------------------------- @@ -465,9 +470,9 @@ let IsSignType g ty = type TraitConstraintSolution = | TTraitUnsolved | TTraitBuiltIn - | TTraitSolved of MethInfo * TypeInst - | TTraitSolvedRecdProp of RecdFieldInfo * bool - | TTraitSolvedAnonRecdProp of AnonRecdTypeInfo * TypeInst * int + | TTraitSolved of minfo: MethInfo * minst: TypeInst * staticTyOpt: TType option + | TTraitSolvedRecdProp of fieldInfo: RecdFieldInfo * isSetProp: bool + | TTraitSolvedAnonRecdProp of anonRecdTypeInfo: AnonRecdTypeInfo * typeInst: TypeInst * index: int let BakedInTraitConstraintNames = [ "op_Division" ; "op_Multiply"; "op_Addition" @@ -694,7 +699,12 @@ let SubstMeasure (r: Typar) ms = let rec TransactStaticReq (csenv: ConstraintSolverEnv) (trace: OptionalTrace) (tpr: Typar) req = let m = csenv.m - if tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then + let g = csenv.g + + // Prior to feature InterfacesWithAbstractStaticMembers the StaticReq must match the + // declared StaticReq. With feature InterfacesWithAbstractStaticMembers it is inferred + // from the finalized constraints on the type variable. + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) && tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name), m, m)) else let orig = tpr.StaticReq @@ -996,23 +1006,30 @@ and SolveTyparEqualsTypePart2 (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) // Re-solve the other constraints associated with this type variable - return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r + return! SolveTypMeetsTyparConstraints csenv ndeep m2 trace ty r } /// Apply the constraints on 'typar' to the type 'ty' -and solveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty (r: Typar) = trackErrors { +and SolveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty (r: Typar) = trackErrors { let g = csenv.g // Propagate compat flex requirements from 'tp' to 'ty' do! SolveTypIsCompatFlex csenv trace r.IsCompatFlex ty - // Propagate dynamic requirements from 'tp' to 'ty' + // Propagate dynamic requirements from 'tp' to 'ty' do! SolveTypDynamicReq csenv trace r.DynamicReq ty // Propagate static requirements from 'tp' to 'ty' do! SolveTypStaticReq csenv trace r.StaticReq ty - + + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then + // Propagate static requirements from 'tp' to 'ty' + // + // If IWSAMs are not supported then this is done on a per-type-variable basis when constraints + // are applied - see other calls to SolveTypStaticReq + do! SolveTypStaticReq csenv trace r.StaticReq ty + // Solve constraints on 'tp' w.r.t. 'ty' for e in r.Constraints do do! @@ -1367,45 +1384,60 @@ 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(tys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo + let (TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else + let g = csenv.g let m = csenv.m let amap = csenv.amap let aenv = csenv.EquivEnv let denv = csenv.DisplayEnv + let ndeep = ndeep + 1 do! DepthCheck ndeep m // Remove duplicates from the set of types in the support - let tys = ListSet.setify (typeAEquiv g aenv) tys + let supportTys = ListSet.setify (typeAEquiv g aenv) supportTys // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(tys, nm, memFlags, traitObjAndArgTys, retTy, sln) + let traitInfo = TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln) let retTy = GetFSharpViewOfReturnType g retTy // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then - match tys, traitObjAndArgTys with + match supportTys, traitObjAndArgTys with | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) - // Trait calls are only supported on pseudo type (variables) - for e in tys do - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e - + + // Trait calls are only supported on pseudo type (variables) + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then + for e in supportTys do + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e + + // SRTP constraints on rigid type parameters do not need to be solved + let isRigid = + supportTys |> List.forall (fun ty -> + match tryDestTyparTy g ty with + | ValueSome tp -> + match tp.Rigidity with + | TyparRigidity.Rigid + | TyparRigidity.WillBeRigid -> true + | _ -> false + | ValueNone -> false) + let argTys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo let! res = trackErrors { - match minfos, tys, memFlags.IsInstance, nm, argTys with + 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 + // float32 * float32 -> float32 // float<'u> * float<'v> -> float<'u 'v> // float32<'u> * float32<'v> -> float32<'u 'v> // decimal<'u> * decimal<'v> -> decimal<'u 'v> @@ -1464,7 +1496,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, 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 ) && + (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)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 @@ -1473,7 +1505,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, 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 ) && + (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && ( IsRelationalType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 || IsRelationalType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 @@ -1564,7 +1596,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | _, _, true, "get_Sign", [] - when IsSignType g tys.Head -> + when IsSignType g supportTys.Head -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.int32_ty return TTraitBuiltIn @@ -1651,11 +1683,11 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let recdPropSearch = let isGetProp = nm.StartsWithOrdinal("get_") let isSetProp = nm.StartsWithOrdinal("set_") - if argTys.IsEmpty && isGetProp || isSetProp then + if not isRigid && ((argTys.IsEmpty && isGetProp) || isSetProp) then let propName = nm[4..] let props = - tys |> List.choose (fun ty -> - match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere) FindMemberFlag.IgnoreOverrides m ty with + supportTys |> List.choose (fun ty -> + match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with | Some (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && (rfinfo.IsStatic = not memFlags.IsInstance) && @@ -1672,10 +1704,10 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let anonRecdPropSearch = let isGetProp = nm.StartsWith "get_" - if isGetProp && memFlags.IsInstance then + if not isRigid && isGetProp && memFlags.IsInstance then let propName = nm[4..] let props = - tys |> List.choose (fun ty -> + supportTys |> List.choose (fun ty -> match NameResolution.TryFindAnonRecdFieldOfType g ty propName with | Some (NameResolution.Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) | _ -> None) @@ -1688,10 +1720,10 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // Now check if there are no feasible solutions at all match minfos, recdPropSearch, anonRecdPropSearch with | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> - if tys |> List.exists (isFunTy g) then - return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) - elif tys |> List.exists (isAnyTupleTy g) then - return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) + if supportTys |> List.exists (isFunTy g) then + return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) + elif supportTys |> List.exists (isAnyTupleTy g) then + return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) else match nm, argTys with | "op_Explicit", [argTy] -> @@ -1700,19 +1732,19 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyString, rtyString), m, m2)) | _ -> let tyString = - match tys with + match supportTys with | [ty] -> NicePrint.minimalStringOfType denv ty - | _ -> tys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " + | _ -> supportTys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " let opName = ConvertValLogicalNameToDisplayNameCore nm let err = match opName with | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" | ">=?" | ">?" | "<=?" | "?" | "?>=?" | "?>?" | "?<=?" | "??" -> - if List.isSingleton tys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) | _ -> - if List.isSingleton tys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) return! ErrorD(ConstraintSolverError(err, m, m2)) @@ -1721,14 +1753,14 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let calledMethGroup = minfos // curried members may not be used to satisfy constraints - |> List.choose (fun minfo -> + |> List.choose (fun (staticTy, minfo) -> if minfo.IsCurried then None else let callerArgs = { Unnamed = [ (argTys |> List.map (fun argTy -> CallerArg(argTy, m, false, dummyExpr))) ] Named = [ [ ] ] } let minst = FreshenMethInfo 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(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) let methOverloadResult, errors = trace.CollectThenUndoOrCommit @@ -1762,43 +1794,60 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 )) else do! CheckMethInfoAttributes g m None minfo - return TTraitSolved (minfo, calledMeth.CalledTyArgs) + return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType) | _ -> - let support = GetSupportOfMemberConstraint csenv traitInfo - let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo - - // 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 - do! errors - // Otherwise re-record the trait waiting for canonicalization - else - do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees - - match errors with - | ErrorResult (_, UnresolvedOverloading _) - when - not ignoreUnresolvedOverload && - csenv.ErrorOnFailedMemberConstraintResolution && - (not (nm = "op_Explicit" || nm = "op_Implicit")) -> - return! ErrorD AbortForFailedMemberConstraintResolution - | _ -> - return TTraitUnsolved + do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors + return TTraitUnsolved } return! RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res } +and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors = + trackErrors { + let g = csenv.g + + let nm = traitInfo.MemberLogicalName + let supportTypars = GetTyparSupportOfMemberConstraint csenv traitInfo + let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo + + // Trait calls are only supported on pseudo type (variables) unless supported by IWSAM constraints + // + // SolveTypStaticReq is applied here if IWSAMs are supported + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + for supportTypar in supportTypars do + if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTypar) then + do! SolveTypStaticReqTypar csenv trace TyparStaticReq.HeadType supportTypar + + // 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 + do! errors + // Otherwise re-record the trait waiting for canonicalization + else + do! AddMemberConstraint csenv ndeep m2 trace traitInfo supportTypars frees + + match errors with + | ErrorResult (_, UnresolvedOverloading _) + when + not ignoreUnresolvedOverload && + csenv.ErrorOnFailedMemberConstraintResolution && + (not (nm = "op_Explicit" || nm = "op_Implicit")) -> + return! ErrorD AbortForFailedMemberConstraintResolution + | _ -> + () + } + /// Record the solution to a member constraint in the mutable reference cell attached to /// each member constraint. -and RecordMemberConstraintSolution css m trace traitInfo res = - match res with +and RecordMemberConstraintSolution css m trace traitInfo traitConstraintSln = + match traitConstraintSln with | TTraitUnsolved -> ResultD false - | TTraitSolved (minfo, minst) -> - let sln = MemberConstraintSolutionOfMethInfo css m minfo minst + | TTraitSolved (minfo, minst, staticTyOpt) -> + let sln = MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt TransactMemberConstraintSolution traitInfo trace sln ResultD true @@ -1817,7 +1866,7 @@ and RecordMemberConstraintSolution css m trace traitInfo res = ResultD true /// Convert a MethInfo into the data we save in the TAST -and MemberConstraintSolutionOfMethInfo css m minfo minst = +and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt = #if !NO_TYPEPROVIDERS #else // to prevent unused parameter warning @@ -1827,10 +1876,10 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = | ILMeth(_, ilMeth, _) -> let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType, ilMeth.RawMetadata) let iltref = ilMeth.ILExtensionMethodDeclaringTyconRef |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) - ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst) + ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst, staticTyOpt) | FSMeth(_, ty, vref, _) -> - FSMethSln(ty, vref, minst) + FSMethSln(ty, vref, minst, staticTyOpt) | MethInfo.DefaultStructCtor _ -> error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) @@ -1853,7 +1902,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let declaringTy = ImportProvidedType amap m (methInfo.PApply((fun x -> x.DeclaringType), m)) if isILAppTy g declaringTy then let extOpt = None // EXTENSION METHODS FROM TYPE PROVIDERS: for extension methods coming from the type providers we would have something here. - ILMethSln(declaringTy, extOpt, ilMethRef, methInst) + ILMethSln(declaringTy, extOpt, ilMethRef, methInst, staticTyOpt) else closedExprSln | _ -> @@ -1868,45 +1917,91 @@ 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 (TTrait(tys, _, memFlags, argTys, retTy, soln) as traitInfo): MethInfo list = +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 - let minfos = - match memFlags.MemberKind with - | SynMemberKind.Constructor -> - tys |> List.map (GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m) - | _ -> - tys |> List.map (GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm) AccessibleFromSomeFSharpCode AllowMultiIntfInstantiations.Yes IgnoreOverrides m) + + let nominalTys = GetNominalSupportOfMemberConstraint csenv nm traitInfo + + let minfos = + [ for (supportTy, nominalTy) in nominalTys do + let infos = + match memFlags.MemberKind with + | SynMemberKind.Constructor -> + GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m nominalTy + | _ -> + GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm) AccessibleFromSomeFSharpCode AllowMultiIntfInstantiations.Yes IgnoreOverrides m nominalTy + for info in infos do + supportTy, info ] // 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 = List.reduce (ListSet.unionFavourLeft MethInfo.MethInfosUseIdenticalDefinitions) minfos + let minfos = ListSet.setify (fun (_,minfo1) (_, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) minfos /// 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) + let relevantMinfos = minfos |> List.filter(fun (_, minfo) -> not minfo.IsDispatchSlot && not minfo.IsVirtual && minfo.IsInstance) minfos - |> List.filter(fun minfo1 -> + |> List.filter(fun (_, minfo1) -> not(minfo1.IsDispatchSlot && relevantMinfos - |> List.exists (fun minfo2 -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) + |> List.exists (fun (_, minfo2) -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) else [] // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then - results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" (TTrait(tys, "op_Implicit", memFlags, argTys, retTy, soln)) + let (TTrait(supportTys, _, memFlags, argTys, retTy, soln)) = traitInfo + let traitInfo2 = TTrait(supportTys, "op_Implicit", memFlags, argTys, retTy, soln) + results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" traitInfo2 else results -/// The nominal support of the member constraint -and GetSupportOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = - tys |> List.choose (tryAnyParTyOption csenv.g) +/// The typar support of the member constraint. +and GetTyparSupportOfMemberConstraint csenv traitInfo = + traitInfo.SupportTypes |> List.choose (tryAnyParTyOption csenv.g) -/// Check if the support is fully solved. -and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = - tys |> List.forall (isAnyParTy csenv.g >> not) +/// The nominal types supporting the solution of a particular named SRTP constraint. +/// Constraints providing interfaces with static abstract methods can be +/// used to solve SRTP static member constraints on type parameters. +and GetNominalSupportOfMemberConstraint csenv nm traitInfo = + let m = csenv.m + let g = csenv.g + let infoReader = csenv.InfoReader + [ for supportTy in traitInfo.SupportTypes do + if isTyparTy g supportTy then + let mutable replaced = false + for cx in (destTyparTy g supportTy).Constraints do + match cx with + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceTypeWithMatchingStaticAbstractMember m nm AccessibleFromSomeFSharpCode interfaceTy -> + replaced <- true + (supportTy, interfaceTy) + | _ -> () + if not replaced then + (supportTy, supportTy) + else + (supportTy, supportTy) ] + +and SupportTypeHasInterfaceWithMatchingStaticAbstractMember (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) (supportTyPar: Typar) = + let g = csenv.g + let m = csenv.m + let infoReader = csenv.InfoReader + + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + let mutable found = false + for cx in supportTyPar.Constraints do + match cx with + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceTypeWithMatchingStaticAbstractMember m traitInfo.MemberLogicalName AccessibleFromSomeFSharpCode interfaceTy -> + found <- true + | _ -> () + found + else + false + +and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) supportTypar = + SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo supportTypar // This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 // /// Check if some part of the support is solved. @@ -1914,8 +2009,9 @@ and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait( // tys |> List.exists (isAnyParTy csenv.g >> not) /// Get all the unsolved typars (statically resolved or not) relevant to the member constraint -and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, argTys, retTy, _)) = - freeInTypesLeftToRightSkippingConstraints csenv.g (tys @ argTys @ Option.toList retTy) +and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) traitInfo = + let (TTrait(supportTys, _, _, argTys, retTy, _)) = traitInfo + freeInTypesLeftToRightSkippingConstraints csenv.g (supportTys @ argTys @ Option.toList retTy) and MemberConstraintIsReadyForWeakResolution csenv traitInfo = SupportOfMemberConstraintIsFullySolved csenv traitInfo @@ -1924,7 +2020,17 @@ and MemberConstraintIsReadyForStrongResolution csenv traitInfo = SupportOfMemberConstraintIsFullySolved csenv traitInfo and MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo = - SupportOfMemberConstraintIsFullySolved csenv traitInfo + SupportOfMemberConstraintIsFullySolved csenv traitInfo || + // Left-bias for SRTP constraints where the first is constrained by an IWSAM type. This is because typical IWSAM hierarchies + // such as System.Numerics hierarchy math are left-biased. + (match traitInfo.SupportTypes with + | firstSupportTy :: _ -> isAnyParTy csenv.g firstSupportTy && SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy csenv.g firstSupportTy) + | _ -> false) + +/// Check if the support is fully solved. +and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) traitInfo = + let g = csenv.g + traitInfo.SupportTypes |> List.forall (fun ty -> if isAnyParTy g ty then SupportTypeOfMemberConstraintIsSolved csenv traitInfo (destAnyParTy g ty) else true) /// Re-solve the global constraints involving any of the given type variables. /// Trait constraints can't always be solved using the pessimistic rules. We only canonicalize @@ -1986,138 +2092,181 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr } -/// Record a constraint on an inference type variable. -and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint = +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 + memFlags1.IsInstance = memFlags2.IsInstance && + nm1 = nm2 && + // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. + // See FSharp 1.0 bug 6477. + not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && + argTys1.Length = argTys2.Length && + (List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2 || retry) + +// Type variable sets may not have two trait constraints with the same name, nor +// be constrained by different instantiations of the same interface type. +// +// This results in limitations on generic code, especially "inline" code, which +// may require type annotations. +// +// The 'retry' flag is passed when a rigid type variable is about to raise a missing constraint error +// and the lengths of the support types are not equal (i.e. one is length 1, the other is length 2). +// In this case the support types are first forced to be equal. +and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace retry tpc1 tpc2 = trackErrors { let g = csenv.g - let aenv = csenv.EquivEnv let amap = csenv.amap - let denv = csenv.DisplayEnv let m = csenv.m - - // Type variable sets may not have two trait constraints with the same name, nor - // be constrained by different instantiations of the same interface type. - // - // This results in limitations on generic code, especially "inline" code, which - // may require type annotations. See FSharp 1.0 bug 6477. - let consistent tpc1 tpc2 = - match tpc1, tpc2 with - | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argTys1, rty1, _), _), - TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argTys2, rty2, _), _)) - when (memFlags1 = memFlags2 && - nm1 = nm2 && - // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. - // See FSharp 1.0 bug 6477. - not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && - argTys1.Length = argTys2.Length && - List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2) -> - - let rty1 = GetFSharpViewOfReturnType g rty1 - let rty2 = GetFSharpViewOfReturnType g rty2 - trackErrors { - do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - () - } + 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 + if retry then + match tys1, tys2 with + | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 + | [ty1], _ -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1) tys2 + | _, [ty2] -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty2) tys1 + | _ -> () + do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 + let rty1 = GetFSharpViewOfReturnType g rty1 + let rty2 = GetFSharpViewOfReturnType g rty2 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - | (TyparConstraint.CoercesTo(ty1, _), - TyparConstraint.CoercesTo(ty2, _)) -> - // Record at most one subtype constraint for each head type. - // That is, we forbid constraints by both I and I. - // This works because the types on the r.h.s. of subtype - // constraints are head-types and so any further inferences are equational. - let collect ty = - let mutable res = [] - IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty - List.rev res - let parents1 = collect ty1 - let parents2 = collect ty2 - trackErrors { - for ty1Parent in parents1 do - for ty2Parent in parents2 do - do! if not (HaveSameHeadType g ty1Parent ty2Parent) then CompleteD else - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent - } - - | (TyparConstraint.IsEnum (u1, _), - TyparConstraint.IsEnum (u2, m2)) -> - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace u1 u2 + | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> + // Record at most one subtype constraint for each head type. + // That is, we forbid constraints by both I and I. + // This works because the types on the r.h.s. of subtype + // constraints are head-types and so any further inferences are equational. + let collect ty = + let mutable res = [] + IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty + List.rev res + let parents1 = collect ty1 + let parents2 = collect ty2 + for ty1Parent in parents1 do + for ty2Parent in parents2 do + if HaveSameHeadType g ty1Parent ty2Parent then + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent + + | TyparConstraint.IsEnum (unerlyingTy1, _), + TyparConstraint.IsEnum (unerlyingTy2, m2) -> + return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace unerlyingTy1 unerlyingTy2 - | (TyparConstraint.IsDelegate (aty1, bty1, _), - TyparConstraint.IsDelegate (aty2, bty2, m2)) -> trackErrors { - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace aty1 aty2 - return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty1 bty2 - } - - | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ - | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> - ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) - - - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ - | TyparConstraint.SimpleChoice _, TyparConstraint.SimpleChoice _ -> - CompleteD + | TyparConstraint.IsDelegate (argsTy1, retTy1, _), + TyparConstraint.IsDelegate (argsTy2, retTy2, m2) -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argsTy1 argsTy2 + return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy1 retTy2 + + | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ + | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> + return! ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) + + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ + | TyparConstraint.SimpleChoice _, TyparConstraint.SimpleChoice _ -> + () - | _ -> CompleteD + | _ -> () + } - // See when one constraint implies implies another. - // 'a :> ty1 implies 'a :> 'ty2 if the head type name of ty2 (say T2) occursCheck anywhere in the hierarchy of ty1 - // If it does occur, e.g. at instantiation T2, then the check above will have enforced that - // T2 = ty2 - let implies tpc1 tpc2 = - match tpc1, tpc2 with - | TyparConstraint.MayResolveMember(trait1, _), - TyparConstraint.MayResolveMember(trait2, _) -> - traitsAEquiv g aenv trait1 trait2 - - | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> - ExistsSameHeadTypeInHierarchy g amap m ty1 ty2 - - | TyparConstraint.IsEnum(u1, _), TyparConstraint.IsEnum(u2, _) -> typeEquiv g u1 u2 - - | TyparConstraint.IsDelegate(aty1, bty1, _), TyparConstraint.IsDelegate(aty2, bty2, _) -> - typeEquiv g aty1 aty2 && typeEquiv g bty1 bty2 - - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ - // comparison implies equality - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true - | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice (tys2, _) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 - | TyparConstraint.DefaultsTo (priority1, defaultTy1, _), TyparConstraint.DefaultsTo (priority2, defaultTy2, _) -> - (priority1 = priority2) && typeEquiv g defaultTy1 defaultTy2 - | _ -> false +// See when one constraint implies implies another. +// 'a :> ty1 implies 'a :> 'ty2 if the head type name of ty2 (say T2) occursCheck anywhere in the hierarchy of ty1 +// If it does occur, e.g. at instantiation T2, then the check above will have enforced that +// T2 = ty2 +and CheckConstraintImplication (csenv: ConstraintSolverEnv) tpc1 tpc2 = + let g = csenv.g + let aenv = csenv.EquivEnv + let amap = csenv.amap + let m = csenv.m + match tpc1, tpc2 with + | TyparConstraint.MayResolveMember(trait1, _), TyparConstraint.MayResolveMember(trait2, _) -> + traitsAEquiv g aenv trait1 trait2 + + | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> + ExistsSameHeadTypeInHierarchy g amap m ty1 ty2 + + | TyparConstraint.IsEnum(u1, _), TyparConstraint.IsEnum(u2, _) -> typeEquiv g u1 u2 + + | TyparConstraint.IsDelegate(argsTy1, retyTy1, _), TyparConstraint.IsDelegate(argsTy2, retyTy2, _) -> + typeEquiv g argsTy1 argsTy2 && typeEquiv g retyTy1 retyTy2 + + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + // comparison implies equality + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true + | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice (tys2, _) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 + | TyparConstraint.DefaultsTo (priority1, defaultTy1, _), TyparConstraint.DefaultsTo (priority2, defaultTy2, _) -> + (priority1 = priority2) && typeEquiv g defaultTy1 defaultTy2 + | _ -> false - - // First ensure constraint conforms with existing constraints - // NOTE: QUADRATIC +and CheckConstraintsImplication csenv existingConstraints newConstraint = + existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) + +// Ensure constraint conforms with existing constraints +// NOTE: QUADRATIC +and EnforceConstraintSetConsistency csenv ndeep m2 trace retry allCxs i cxs = + match cxs with + | [] -> CompleteD + | cx :: rest -> + trackErrors { + do! IterateIdxD (fun j cx2 -> if i = j then CompleteD else EnforceConstraintConsistency csenv ndeep m2 trace retry cx cx2) allCxs + return! EnforceConstraintSetConsistency csenv ndeep m2 trace retry allCxs (i+1) rest + } + +// Eliminate any constraints where one constraint implies another +// Keep constraints in the left-to-right form according to the order they are asserted. +// NOTE: QUADRATIC +and EliminateRedundantConstraints csenv cxs acc = + match cxs with + | [] -> acc + | cx :: rest -> + let acc = + if List.exists (fun cx2 -> CheckConstraintImplication csenv cx2 cx) acc then acc + else (cx :: acc) + EliminateRedundantConstraints csenv rest acc + +/// Record a constraint on an inference type variable. +and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint = + let denv = csenv.DisplayEnv + let m = csenv.m + let g = csenv.g + let existingConstraints = tp.Constraints let allCxs = newConstraint :: List.rev existingConstraints trackErrors { - let rec enforceMutualConsistency i cxs = - match cxs with - | [] -> CompleteD - | cx :: rest -> - trackErrors { - do! IterateIdxD (fun j cx2 -> if i = j then CompleteD else consistent cx cx2) allCxs - return! enforceMutualConsistency (i+1) rest - } - do! enforceMutualConsistency 0 allCxs - - let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> implies tpc2 newConstraint) + do! EnforceConstraintSetConsistency csenv ndeep m2 trace false allCxs 0 allCxs + let mutable impliedByExistingConstraints = CheckConstraintsImplication csenv existingConstraints newConstraint + + // When InterfacesWithAbstractStaticMembers enabled, retry constraint consistency and implication when one of the constraints is known to have + // a single support type, and the other has two support types. + // (T1 : static member Foo: int) + // and the constraint we're adding is this: + // ((T2 or ?inf) : static member Foo: int) + // + // Then the only logical solution is ?inf = T1 = T2. So just enforce this and try again. + if + not impliedByExistingConstraints && + (IsRigid csenv tp || tp.Rigidity.WarnIfMissingConstraint) && + g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + then + do! EnforceConstraintSetConsistency csenv ndeep m2 trace true allCxs 0 allCxs + impliedByExistingConstraints <- CheckConstraintsImplication csenv existingConstraints newConstraint + if impliedByExistingConstraints then () // "Default" constraints propagate softly and can be omitted from explicit declarations of type parameters elif (match tp.Rigidity, newConstraint with @@ -2125,7 +2274,8 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint | _ -> false) then () elif IsRigid csenv tp then - return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) + if not impliedByExistingConstraints then + return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else // It is important that we give a warning if a constraint is missing from a // will-be-made-rigid type variable. This is because the existence of these warnings @@ -2134,20 +2284,7 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint if tp.Rigidity.WarnIfMissingConstraint then do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) - let newConstraints = - // Eliminate any constraints where one constraint implies another - // Keep constraints in the left-to-right form according to the order they are asserted. - // NOTE: QUADRATIC - let rec eliminateRedundant cxs acc = - match cxs with - | [] -> acc - | cx :: rest -> - let acc = - if List.exists (fun cx2 -> implies cx2 cx) acc then acc - else (cx :: acc) - eliminateRedundant rest acc - - eliminateRedundant allCxs [] + let newConstraints = EliminateRedundantConstraints csenv allCxs [] // Write the constraint into the type variable // Record a entry in the undo trace if one is provided @@ -2321,19 +2458,24 @@ and SolveTypeIsUnmanaged (csenv: ConstraintSolverEnv) ndeep m2 trace ty = ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2)) -and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty tys = - let g = csenv.g - let m = csenv.m - let denv = csenv.DisplayEnv - match tryDestTyparTy g ty with - | ValueSome destTypar -> - AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(tys, m)) - | _ -> - if List.exists (typeEquivAux Erasure.EraseMeasures g ty) tys then CompleteD - else - let tyString = NicePrint.minimalStringOfType denv ty - let tysString = tys |> List.map (NicePrint.prettyStringOfTy denv) |> String.concat "," - ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyString, tysString), m, m2)) +and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys = + trackErrors { + let g = csenv.g + let m = csenv.m + let denv = csenv.DisplayEnv + match tryDestTyparTy g ty with + | ValueSome destTypar -> + // SolveTypStaticReq is applied here if IWSAMs are supported + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType ty + + return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(choiceTys, m)) + | _ -> + if not (choiceTys |> List.exists (typeEquivAux Erasure.EraseMeasures g ty)) then + let tyString = NicePrint.minimalStringOfType denv ty + let tysString = choiceTys |> List.map (NicePrint.prettyStringOfTy denv) |> String.concat "," + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyString, tysString), m, m2)) + } and SolveTypeIsReferenceType (csenv: ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g @@ -2499,12 +2641,11 @@ and CanMemberSigsMatchUpToCheck assignedItemSetters |> MapCombineTDCD (fun (AssignedItemSetter(_, item, caller)) -> let name, calledArgTy = match item with - | AssignedPropSetter(_, pminfo, pminst) -> + | AssignedPropSetter(_, _, pminfo, pminst) -> let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst))) pminfo.LogicalName, calledArgTy | AssignedILFieldSetter(finfo) -> - (* Get or set instance IL field *) let calledArgTy = finfo.FieldType(amap, m) finfo.FieldName, calledArgTy @@ -2814,7 +2955,8 @@ and ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMet and AssumeMethodSolvesTrait (csenv: ConstraintSolverEnv) (cx: TraitConstraintInfo option) m trace (calledMeth: CalledMeth<_>) = match cx with | Some traitInfo when traitInfo.Solution.IsNone -> - let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs + let staticTyOpt = if calledMeth.Method.IsInstance then None else calledMeth.OptionalStaticType + let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs staticTyOpt #if TRAIT_CONSTRAINT_CORRECTIONS if csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections then TransactMemberConstraintSolution traitInfo trace traitSln @@ -2960,7 +3102,7 @@ and ResolveOverloading // Static IL interfaces methods are not supported in lower F# versions. if calledMeth.Method.IsILMethod && not calledMeth.Method.IsInstance && isInterfaceTy g calledMeth.Method.ApparentEnclosingType then - checkLanguageFeatureRuntimeErrorRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m checkLanguageFeatureAndRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m calledMethOpt, @@ -3270,9 +3412,26 @@ let UnifyUniqueOverloading | _ -> ResultD false -/// Remove the global constraints where these type variables appear in the support of the constraint -let EliminateConstraintsForGeneralizedTypars denv css m (trace: OptionalTrace) (generalizedTypars: Typars) = +/// Re-assess the staticness of the type parameters. Necessary prior to assessing generalization. +let UpdateStaticReqOfTypar (denv: DisplayEnv) css m (trace: OptionalTrace) (typar: Typar) = + let g = denv.g + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + trackErrors { + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + for cx in typar.Constraints do + match cx with + | TyparConstraint.MayResolveMember(traitInfo,_) -> + for supportTy in traitInfo.SupportTypes do + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy + | TyparConstraint.SimpleChoice _ -> + do! SolveTypStaticReqTypar csenv trace TyparStaticReq.HeadType typar + | _ -> () + } |> RaiseOperationResult + +/// Remove the global constraints related to generalized type variables +let EliminateConstraintsForGeneralizedTypars (denv: DisplayEnv) css m (trace: OptionalTrace) (generalizedTypars: Typars) = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + for tp in generalizedTypars do let tpn = tp.Stamp let cxst = csenv.SolverState.ExtraCxs @@ -3476,6 +3635,19 @@ 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 @@ -3488,7 +3660,7 @@ let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstrai 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 m typars + 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 @@ -3562,4 +3734,3 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = | _ -> true else true - diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 7891763dd44..c45db538fc2 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -41,7 +41,13 @@ val NewInferenceTypes: TcGlobals -> 'T list -> TType list /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. val FreshenAndFixupTypars: - m: range -> rigid: TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInstantiation * TType list + g: TcGlobals -> + m: range -> + rigid: TyparRigidity -> + Typars -> + TType list -> + 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. @@ -50,13 +56,13 @@ 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: range -> Typars -> Typars * TyparInstantiation * TType list +val FreshenTypeInst: g: TcGlobals -> 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: range -> Typars -> TType list +val FreshenTypars: g: TcGlobals -> 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. @@ -251,7 +257,10 @@ val UnifyUniqueOverloading: OverallTy -> OperationResult -/// Remove the global constraints where these type variables appear in the support of the constraint +/// Re-assess the staticness of the type parameters +val UpdateStaticReqOfTypar: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typar -> unit + +/// Remove the global constraints related to generalized type variables val EliminateConstraintsForGeneralizedTypars: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typars -> unit @@ -304,6 +313,10 @@ val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority val CodegenWitnessExprForTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult +/// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code +val CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs: + TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> OperationResult + /// Generate the arguments passed when using a generic construct that accepts traits witnesses val CodegenWitnessesForTyparInst: TcValF -> diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index e2cc31a265d..48b3ee82694 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.InfoReader open System.Collections.Concurrent +open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL @@ -95,6 +96,51 @@ let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy let GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty = GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m ty ty +/// Query the immediate methods of an F# type, not taking into account inherited methods. The optFilter +/// parameter is an optional name to restrict the set of properties returned. +let GetImmediateTraitsInfosOfType optFilter g ty = + match tryDestTyparTy g ty with + | ValueSome tp -> + let infos = GetTraitConstraintInfosOfTypars g [tp] + match optFilter with + | None -> + [ for traitInfo in infos do + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertySet -> + // A setter property trait only can be utilized via + // ^T.set_Property(v) + traitInfo.WithMemberKind(SynMemberKind.Member) + | _ -> + traitInfo ] + | Some nm -> + [ for traitInfo in infos do + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertyGet -> + // A getter property trait can be utilized via + // ^T.Property + // ^T.get_Property() + // The latter doesn't appear in intellisense + if nm = traitInfo.MemberDisplayNameCore then + traitInfo + let traitInfo2 = traitInfo.WithMemberKind(SynMemberKind.Member) + if nm = traitInfo2.MemberDisplayNameCore then + traitInfo2 + | SynMemberKind.PropertySet -> + // A setter property trait only can be utilized via + // ^T.set_Property(v) + let traitInfo2 = traitInfo.WithMemberKind(SynMemberKind.Member) + if nm = traitInfo2.MemberDisplayNameCore then + traitInfo2 + | _ -> + // Method traits can be utilized via + // ^T.Member(v) + if nm = traitInfo.MemberDisplayNameCore then + traitInfo + ] + + | _ -> + [] + /// A helper type to help collect properties. /// /// Join up getters and setters which are not associated in the F# data structure @@ -247,6 +293,7 @@ let FilterMostSpecificMethInfoSets g amap m (minfoSets: NameMultiMap<_>) : NameM /// Used to collect sets of virtual methods, protected methods, protected /// properties etc. type HierarchyItem = + | TraitItem of TraitConstraintInfo list | MethodItem of MethInfo list list | PropertyItem of PropInfo list list | RecdFieldItem of RecdFieldInfo @@ -393,16 +440,18 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = FoldPrimaryHierarchyOfType (fun ty acc -> ty :: acc) g amap m allowMultiIntfInst ty [] /// The primitive reader for the named items up a hierarchy - let GetIntrinsicNamedItemsUncached ((nm, ad), m, ty) = + let GetIntrinsicNamedItemsUncached ((nm, ad, includeConstraints), m, ty) = if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax let optFilter = Some nm FoldPrimaryHierarchyOfType (fun ty acc -> + let qinfos = if includeConstraints then GetImmediateTraitsInfosOfType optFilter g ty else [] let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty match acc with + | _ when not (isNil qinfos) -> Some(TraitItem (qinfos)) | Some(MethodItem(inheritedMethSets)) when not (isNil minfos) -> Some(MethodItem (minfos :: inheritedMethSets)) | _ when not (isNil minfos) -> Some(MethodItem [minfos]) | Some(PropertyItem(inheritedPropSets)) when not (isNil pinfos) -> Some(PropertyItem(pinfos :: inheritedPropSets)) @@ -615,7 +664,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = /// Make a cache for function 'f' keyed by type (plus some additional 'flags') that only /// caches computations for monomorphic types. - let MakeInfoCache f (flagsEq : System.Collections.Generic.IEqualityComparer<_>) = + let MakeInfoCache f (flagsEq : IEqualityComparer<_>) = MemoizationTable<_, _> (compute=f, // Only cache closed, monomorphic types (closed = all members for the type @@ -627,7 +676,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | _ -> false), keyComparer= - { new System.Collections.Generic.IEqualityComparer<_> with + { new IEqualityComparer<_> with member _.Equals((flags1, _, ty1), (flags2, _, ty2)) = // Ignoring the ranges - that's OK. flagsEq.Equals(flags1, flags2) && @@ -650,27 +699,44 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = else this.TryFindIntrinsicMethInfo m ad "op_Implicit" ty + let IsInterfaceTypeWithMatchingStaticAbstractMemberUncached ((ad, nm), m, ty) = + ExistsInEntireHierarchyOfType (fun parentTy -> + let meths = this.TryFindIntrinsicMethInfo m ad nm parentTy + meths |> List.exists (fun meth -> + not meth.IsInstance && + meth.IsDispatchSlot && + isInterfaceTy g meth.ApparentEnclosingAppType + )) + g amap m AllowMultiIntfInstantiations.Yes ty + let hashFlags0 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((filter: string option, ad: AccessorDomain, _allowMultiIntfInst1)) = hash filter + AccessorDomain.CustomGetHashCode ad member _.Equals((filter1, ad1, allowMultiIntfInst1), (filter2, ad2, allowMultiIntfInst2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) && allowMultiIntfInst1 = allowMultiIntfInst2 } let hashFlags1 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((filter: string option, ad: AccessorDomain)) = hash filter + AccessorDomain.CustomGetHashCode ad member _.Equals((filter1, ad1), (filter2, ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) } let hashFlags2 = - { new System.Collections.Generic.IEqualityComparer with - member _.GetHashCode((nm: string, ad: AccessorDomain)) = hash nm + AccessorDomain.CustomGetHashCode ad - member _.Equals((nm1, ad1), (nm2, ad2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) } + { new IEqualityComparer with + member _.GetHashCode((nm: string, ad: AccessorDomain, includeConstraints)) = + hash nm + AccessorDomain.CustomGetHashCode ad + hash includeConstraints + member _.Equals((nm1, ad1, includeConstraints1), (nm2, ad2, includeConstraints2)) = + (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) && (includeConstraints1 = includeConstraints2) } let hashFlags3 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((ad: AccessorDomain)) = AccessorDomain.CustomGetHashCode ad member _.Equals((ad1), (ad2)) = AccessorDomain.CustomEquals(g, ad1, ad2) } + let hashFlags4 = + { new IEqualityComparer with + member _.GetHashCode((ad, nm)) = AccessorDomain.CustomGetHashCode ad + hash nm + member _.Equals((ad1, nm1), (ad2, nm2)) = AccessorDomain.CustomEquals(g, ad1, ad2) && (nm1 = nm2) } + let methodInfoCache = MakeInfoCache GetIntrinsicMethodSetsUncached hashFlags0 let propertyInfoCache = MakeInfoCache GetIntrinsicPropertySetsUncached hashFlags0 let recdOrClassFieldInfoCache = MakeInfoCache GetIntrinsicRecdOrClassFieldInfosUncached hashFlags1 @@ -682,23 +748,27 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierarchyUncached HashIdentity.Structural let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached HashIdentity.Structural let implicitConversionCache = MakeInfoCache FindImplicitConversionsUncached hashFlags3 + let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache IsInterfaceTypeWithMatchingStaticAbstractMemberUncached hashFlags4 // Runtime feature support - let isRuntimeFeatureSupported (infoReader: InfoReader) runtimeFeature = + let isRuntimeFeatureSupported runtimeFeature = match g.System_Runtime_CompilerServices_RuntimeFeature_ty with | Some runtimeFeatureTy -> - infoReader.GetILFieldInfosOfType (None, AccessorDomain.AccessibleFromEverywhere, range0, runtimeFeatureTy) + GetIntrinsicILFieldInfosUncached ((None, AccessorDomain.AccessibleFromEverywhere), range0, runtimeFeatureTy) |> List.exists (fun (ilFieldInfo: ILFieldInfo) -> ilFieldInfo.FieldName = runtimeFeature) | _ -> false let isRuntimeFeatureDefaultImplementationsOfInterfacesSupported = - lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" - + lazy isRuntimeFeatureSupported "DefaultImplementationsOfInterfaces" + + let isRuntimeFeatureVirtualStaticsInInterfacesSupported = + lazy isRuntimeFeatureSupported "VirtualStaticsInInterfaces" + member _.g = g member _.amap = amap - + /// Read the raw method sets of a type, including inherited ones. Cache the result for monomorphic types member _.GetRawIntrinsicMethodSetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = methodInfoCache.Apply(((optFilter, ad, allowMultiIntfInst), m, ty)) @@ -739,8 +809,8 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | _ -> failwith "unexpected multiple fields with same name" // Because it should have been already reported as duplicate fields /// Try and find an item with the given name in a type. - member _.TryFindNamedItemOfType (nm, ad, m, ty) = - namedItemsCache.Apply(((nm, ad), m, ty)) + member _.TryFindNamedItemOfType ((nm, ad, includeConstraints), m, ty) = + namedItemsCache.Apply(((nm, ad, includeConstraints), m, ty)) /// Read the raw method sets of a type that are the most specific overrides. Cache the result for monomorphic types member _.GetIntrinsicMostSpecificOverrideMethodSetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = @@ -759,6 +829,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = match langFeature with // Both default and static interface method consumption features are tied to the runtime support of DIMs. | LanguageFeature.DefaultInterfaceMemberConsumption -> isRuntimeFeatureDefaultImplementationsOfInterfacesSupported.Value + | LanguageFeature.InterfacesWithAbstractStaticMembers -> isRuntimeFeatureVirtualStaticsInInterfacesSupported.Value | _ -> true /// Get the declared constructors of any F# type @@ -822,8 +893,11 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member infoReader.GetIntrinsicPropInfosOfType optFilter ad allowMultiIntfInst findFlag m ty = infoReader.GetIntrinsicPropInfoSetsOfType optFilter ad allowMultiIntfInst findFlag m ty |> List.concat - member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad) findFlag m ty = - match infoReader.TryFindNamedItemOfType(nm, ad, m, ty) with + member _.GetTraitInfosInType optFilter ty = + GetImmediateTraitsInfosOfType optFilter g ty + + member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty = + match infoReader.TryFindNamedItemOfType((nm, ad, includeConstraints), m, ty) with | Some item -> match item with | PropertyItem psets -> Some(PropertyItem (psets |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m)) @@ -832,7 +906,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | None -> None /// Try to detect the existence of a method on a type. - member infoReader.TryFindIntrinsicMethInfo m ad nm ty = + member infoReader.TryFindIntrinsicMethInfo m ad nm ty : MethInfo list = infoReader.GetIntrinsicMethInfosOfType (Some nm) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides m ty /// Try to find a particular named property on a type. Only used to ensure that local 'let' definitions and property names @@ -843,22 +917,13 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.FindImplicitConversions m ad ty = implicitConversionCache.Apply((ad, m, ty)) -let private tryLanguageFeatureRuntimeErrorAux (infoReader: InfoReader) langFeature m error = + member _.IsInterfaceTypeWithMatchingStaticAbstractMember m nm ad ty = + isInterfaceWithStaticAbstractMethodCache.Apply((ad, nm), m, ty) + +let checkLanguageFeatureRuntimeAndRecover (infoReader: InfoReader) langFeature m = if not (infoReader.IsLanguageFeatureRuntimeSupported langFeature) then let featureStr = infoReader.g.langVersion.GetFeatureString langFeature - error (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m)) - false - else - true - -let checkLanguageFeatureRuntimeError infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m error |> ignore - -let checkLanguageFeatureRuntimeErrorRecover infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR |> ignore - -let tryLanguageFeatureRuntimeErrorRecover infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR + errorR (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m)) let GetIntrinsicConstructorInfosOfType (infoReader: InfoReader) m ty = infoReader.GetIntrinsicConstructorInfosOfTypeAux m ty ty @@ -881,8 +946,8 @@ let GetIntrinsicMethInfosOfType (infoReader: InfoReader) optFilter ad allowMulti let GetIntrinsicPropInfosOfType (infoReader: InfoReader) optFilter ad allowMultiIntfInst findFlag m ty = infoReader.GetIntrinsicPropInfosOfType optFilter ad allowMultiIntfInst findFlag m ty -let TryFindIntrinsicNamedItemOfType (infoReader: InfoReader) (nm, ad) findFlag m ty = - infoReader.TryFindIntrinsicNamedItemOfType (nm, ad) findFlag m ty +let TryFindIntrinsicNamedItemOfType (infoReader: InfoReader) (nm, ad, includeConstraints) findFlag m ty = + infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty let TryFindIntrinsicMethInfo (infoReader: InfoReader) m ad nm ty = infoReader.TryFindIntrinsicMethInfo m ad nm ty diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index c8cec7f82da..da24ec26d9e 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -73,6 +73,7 @@ val FilterMostSpecificMethInfoSets: /// Used to collect sets of virtual methods, protected methods, protected /// properties etc. type HierarchyItem = + | TraitItem of TraitConstraintInfo list | MethodItem of MethInfo list list | PropertyItem of PropInfo list list | RecdFieldItem of RecdFieldInfo @@ -150,7 +151,10 @@ type InfoReader = ty: TType -> MethInfo list list - /// Get the sets intrinsic properties in the hierarchy (not including extension properties) + /// Get the trait infos for a type variable (empty for everything else) + member GetTraitInfosInType: optFilter: string option -> ty: TType -> TraitConstraintInfo list + + /// Get the sets of intrinsic properties in the hierarchy (not including extension properties) member GetIntrinsicPropInfoSetsOfType: optFilter: string option -> ad: AccessorDomain -> @@ -182,20 +186,22 @@ type InfoReader = /// Perform type-directed name resolution of a particular named member in an F# type member TryFindIntrinsicNamedItemOfType: - nm: string * ad: AccessorDomain -> findFlag: FindMemberFlag -> m: range -> ty: TType -> HierarchyItem option + nm: string * ad: AccessorDomain * includeConstraints: bool -> + findFlag: FindMemberFlag -> + m: range -> + ty: TType -> + HierarchyItem option /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list -val checkLanguageFeatureRuntimeError: - infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit + /// Determine if a type has a static abstract method with the given name somewhere in its hierarchy + member IsInterfaceTypeWithMatchingStaticAbstractMember: + m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool -val checkLanguageFeatureRuntimeErrorRecover: +val checkLanguageFeatureRuntimeAndRecover: infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit -val tryLanguageFeatureRuntimeErrorRecover: - infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> bool - /// Get the declared constructors of any F# type val GetIntrinsicConstructorInfosOfType: infoReader: InfoReader -> m: range -> ty: TType -> MethInfo list @@ -252,7 +258,7 @@ val GetIntrinsicPropInfosOfType: /// Perform type-directed name resolution of a particular named member in an F# type val TryFindIntrinsicNamedItemOfType: infoReader: InfoReader -> - nm: string * ad: AccessorDomain -> + nm: string * ad: AccessorDomain * includeConstraints: bool -> findFlag: FindMemberFlag -> m: range -> ty: TType -> diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 8f89c68d55e..76d0560349d 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -12,6 +12,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features +open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.IO @@ -101,7 +102,8 @@ type AssignedCalledArg<'T> = /// Represents the possibilities for a named-setter argument (a property, field, or a record field setter) type AssignedItemSetterTarget = - | AssignedPropSetter of PropInfo * MethInfo * TypeInst (* the MethInfo is a non-indexer setter property *) + // the MethInfo is a non-indexer setter property + | AssignedPropSetter of staticTyOpt: TType option * pinfo: PropInfo * minfo: MethInfo * pminst: TypeInst | AssignedILFieldSetter of ILFieldInfo | AssignedRecdFieldSetter of RecdFieldInfo @@ -197,11 +199,13 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT isTyparTy g actualTy && (let ftyvs = freeInType CollectAll reqdTy2 in ftyvs.FreeTypars.Contains(destTyparTy g actualTy))) then let implicits = - infoReader.FindImplicitConversions m ad actualTy @ - infoReader.FindImplicitConversions m ad reqdTy2 + [ for conv in infoReader.FindImplicitConversions m ad actualTy do + (conv, actualTy) + for conv in infoReader.FindImplicitConversions m ad reqdTy2 do + (conv, reqdTy2) ] let implicits = - implicits |> List.filter (fun minfo -> + implicits |> List.filter (fun (minfo, _staticTy) -> not minfo.IsInstance && minfo.FormalMethodTyparInst.IsEmpty && (match minfo.GetParamTypes(amap, m, []) with @@ -212,12 +216,12 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT ) match implicits with - | [minfo] -> - Some (minfo, (reqdTy, reqdTy2, ignore)) - | minfo :: _ -> - Some (minfo, (reqdTy, reqdTy2, fun denv -> + | [(minfo, staticTy) ] -> + Some (minfo, staticTy, (reqdTy, reqdTy2, ignore)) + | (minfo, staticTy) :: _ -> + Some (minfo, staticTy, (reqdTy, reqdTy2, fun denv -> let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy2 actualTy - let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv implicits + let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv (List.map fst implicits) errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m)))) | _ -> None else @@ -289,7 +293,7 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn + | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None @@ -488,6 +492,7 @@ let MakeCalledArgs amap m (minfo: MethInfo) minst = /// Do we allow the use of a param args method in its "expanded" form? /// Do we allow the use of the transformation that converts out arguments as tuple returns? /// Method parameters +/// The optional static type governing a constrained static virtual interface call type CalledMeth<'T> (infoReader: InfoReader, nameEnv: NameResolutionEnv option, @@ -503,7 +508,8 @@ type CalledMeth<'T> callerArgs: CallerArgs<'T>, allowParamArgs: bool, allowOutAndOptArgs: bool, - tyargsOpt: TType option) + tyargsOpt: TType option, + staticTyOpt: TType option) = let g = infoReader.g let methodRetTy = if minfo.IsConstructor then minfo.ApparentEnclosingType else minfo.GetFSharpReturnType(infoReader.amap, m, calledTyArgs) @@ -617,7 +623,8 @@ type CalledMeth<'T> | [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer -> let pminfo = pinfo.SetterMethod let pminst = freshenMethInfo m pminfo - Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e)) + let propStaticTyOpt = if isTyparTy g returnedObjTy then Some returnedObjTy else None + Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(propStaticTyOpt, pinfo, pminfo, pminst), e)) | _ -> let epinfos = match nameEnv with @@ -636,7 +643,8 @@ type CalledMeth<'T> | Some(TType_app(_, types, _)) -> types | _ -> pminst - Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e)) + let propStaticTyOpt = if isTyparTy g returnedObjTy then Some returnedObjTy else None + Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(propStaticTyOpt, pinfo, pminfo, pminst), e)) | _ -> match infoReader.GetILFieldInfosOfType(Some(nm), ad, m, returnedObjTy) with | finfo :: _ -> @@ -792,6 +800,8 @@ type CalledMeth<'T> member x.TotalNumAssignedNamedArgs = x.ArgSets |> List.sumBy (fun x -> x.NumAssignedNamedArgs) + member x.OptionalStaticType = staticTyOpt + override x.ToString() = "call to " + minfo.ToString() let NamesOfCalledArgs (calledArgs: CalledArg list) = @@ -869,11 +879,14 @@ let IsBaseCall objArgs = /// Compute whether we insert a 'coerce' on the 'this' pointer for an object model call /// For example, when calling an interface method on a struct, or a method on a constrained /// variable type. -let ComputeConstrainedCallInfo g amap m (objArgs, minfo: MethInfo) = - match objArgs with - | [objArgExpr] when not minfo.IsExtensionMember -> +let ComputeConstrainedCallInfo g amap m staticTyOpt args (minfo: MethInfo) = + match args, staticTyOpt with + | _, Some staticTy when not minfo.IsExtensionMember && not minfo.IsInstance && minfo.IsAbstract -> Some staticTy + + | (objArgExpr :: _), _ when minfo.IsInstance && not minfo.IsExtensionMember -> let methObjTy = minfo.ApparentEnclosingType let objArgTy = tyOfExpr g objArgExpr + let objArgTy = if isByrefTy g objArgTy then destByrefTy g objArgTy else objArgTy if TypeDefinitelySubsumesTypeNoCoercion 0 g amap m methObjTy objArgTy // Constrained calls to class types can only ever be needed for the three class types that // are base types of value types @@ -891,8 +904,8 @@ let ComputeConstrainedCallInfo g amap m (objArgs, minfo: MethInfo) = /// Adjust the 'this' pointer before making a call /// Take the address of a struct, and coerce to an interface/base/constraint type if necessary -let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m objArgs f = - let ccallInfo = ComputeConstrainedCallInfo g amap m (objArgs, minfo) +let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m staticTyOpt objArgs f = + let ccallInfo = ComputeConstrainedCallInfo g amap m staticTyOpt objArgs minfo let wrap, objArgs = @@ -1007,11 +1020,18 @@ let BuildFSharpMethodCall g m (ty, vref: ValRef) valUseFlags minst args = /// Make a call to a method info. Used by the optimizer and code generator to build /// calls to the type-directed solutions to member constraints. -let MakeMethInfoCall amap m minfo minst args = - let valUseFlags = NormalValUse // correct unless if we allow wild trait constraints like "T has a ctor and can be used as a parent class" +let MakeMethInfoCall (amap: ImportMap) m (minfo: MethInfo) minst args staticTyOpt = + let g = amap.g + let ccallInfo = ComputeConstrainedCallInfo g amap m staticTyOpt args minfo + let valUseFlags = + match ccallInfo with + | Some ty -> + // printfn "possible constrained call to '%s' at %A" minfo.LogicalName m + PossibleConstrainedCall ty + | None -> + NormalValUse match minfo with - | ILMeth(g, ilminfo, _) -> let direct = not minfo.IsVirtual let isProp = false // not necessarily correct, but this is only used post-creflect where this flag is irrelevant @@ -1069,10 +1089,10 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: ra // minst: the instantiation to apply for a generic method // objArgs: the 'this' argument, if any // args: the arguments, if any -let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objArgs args = +let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt = let direct = IsBaseCall objArgs - TakeObjAddrForMethodCall g amap minfo isMutable m objArgs (fun ccallInfo objArgs -> + TakeObjAddrForMethodCall g amap minfo isMutable m staticTyOpt objArgs (fun ccallInfo objArgs -> let allArgs = objArgs @ args let valUseFlags = if direct && (match valUseFlags with NormalValUse -> true | _ -> false) then @@ -1154,7 +1174,7 @@ let ILFieldStaticChecks g amap infoReader ad m (finfo : ILFieldInfo) = // Static IL interfaces fields are not supported in lower F# versions. if isInterfaceTy g finfo.ApparentEnclosingType then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m checkLanguageFeatureAndRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m CheckILFieldAttributes g finfo m @@ -1287,9 +1307,10 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade else match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _) -> + | Some (minfo, staticTy, _) -> MethInfoChecks g amap false None [] ad m minfo - let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] + let staticTyOpt = if isTyparTy g staticTy then Some staticTy else None + let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy) callExpr | None -> mkCoerceIfNeeded g reqdTy actualTy expr @@ -1438,7 +1459,7 @@ let MakeNullableExprIfNeeded (infoReader: InfoReader) calledArgTy callerArgTy ca let calledNonOptTy = destNullableTy g calledArgTy let minfo = GetIntrinsicConstructorInfosOfType infoReader m calledArgTy |> List.head let callerArgExprCoerced = mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr - MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] + MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None // Adjust all the optional arguments, filling in values for defaults, let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) = @@ -1949,7 +1970,7 @@ module ProvidedMethodCalls = let targetMethInfo = ProvidedMeth(amap, ctor.PApply((fun ne -> upcast ne), m), None, m) let objArgs = [] let arguments = [ for ea in args.PApplyArray(id, "GetInvokerExpression", m) -> exprToExpr ea ] - let callExpr = BuildMethodCall tcVal g amap Mutates.PossiblyMutates m false targetMethInfo isSuperInit [] objArgs arguments + let callExpr = BuildMethodCall tcVal g amap Mutates.PossiblyMutates m false targetMethInfo isSuperInit [] objArgs arguments None callExpr and addVar (v: Tainted) = @@ -1984,7 +2005,7 @@ module ProvidedMethodCalls = let mut = if top then mut else PossiblyMutates let isSuperInit = if top then isSuperInit else ValUseFlag.NormalValUse let isProp = if top then isProp else false - let callExpr = BuildMethodCall tcVal g amap mut m isProp targetMethInfo isSuperInit replacementGenericArguments objArgs arguments + let callExpr = BuildMethodCall tcVal g amap mut m isProp targetMethInfo isSuperInit replacementGenericArguments objArgs arguments None Some meth, callExpr and varToExpr (pe: Tainted) = @@ -2059,7 +2080,7 @@ let CheckRecdFieldMutation m denv (rfinfo: RecdFieldInfo) = if not rfinfo.RecdField.IsMutable then errorR (FieldNotMutable (denv, rfinfo.RecdFieldRef, m)) -/// Generate a witness for the given (solved) constraint. Five possiblilities are taken +/// 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 /// 2. The constraint is solved by an F# record field @@ -2081,7 +2102,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = // Given the solution information, reconstruct the MethInfo for the solution match sln with - | ILMethSln(origTy, extOpt, mref, minst) -> + | ILMethSln(origTy, extOpt, mref, minst, staticTyOpt) -> let metadataTy = convertToTypeWithMetadataIfPossible g origTy let tcref = tcrefOfAppTy g metadataTy let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref @@ -2091,10 +2112,10 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = | Some ilActualTypeRef -> let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) - Choice1Of5 (ilMethInfo, minst) + Choice1Of5 (ilMethInfo, minst, staticTyOpt) - | FSMethSln(ty, vref, minst) -> - Choice1Of5 (FSMeth(g, ty, vref, None), minst) + | FSMethSln(ty, vref, minst, staticTyOpt) -> + Choice1Of5 (FSMeth(g, ty, vref, None), minst, staticTyOpt) | FSRecdFieldSln(tinst, rfref, isSetProp) -> Choice2Of5 (tinst, rfref, isSetProp) @@ -2109,7 +2130,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = Choice5Of5 () match sln with - | Choice1Of5(minfo, methArgTys) -> + | Choice1Of5(minfo, methArgTys, staticTyOpt) -> let argExprs = // FIX for #421894 - typechecker assumes that coercion can be applied for the trait // calls arguments but codegen doesn't emit coercion operations @@ -2149,9 +2170,9 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) | _ -> - Some (MakeMethInfoCall amap m minfo methArgTys argExprs) + Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) else - Some (MakeMethInfoCall amap m minfo methArgTys argExprs) + Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) | Choice2Of5 (tinst, rfref, isSet) -> match isSet, rfref.RecdField.IsStatic, argExprs.Length with @@ -2208,7 +2229,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = /// Generate a lambda expression for the given solved trait. let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) = - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let argTysl = GenWitnessArgTys g witnessInfo let vse = argTysl |> List.mapiSquared (fun i j ty -> mkCompGenLocal m ("arg" + string i + "_" + string j) ty) let vsl = List.mapSquared fst vse diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index 5a54954eeff..ad5bb10ebaa 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -83,7 +83,7 @@ type AssignedCalledArg<'T> = /// Represents the possibilities for a named-setter argument (a property, field, or a record field setter) type AssignedItemSetterTarget = - | AssignedPropSetter of PropInfo * MethInfo * TypeInst + | AssignedPropSetter of staticTyOpt: TType option * pinfo: PropInfo * minfo: MethInfo * pminst: TypeInst | AssignedILFieldSetter of ILFieldInfo | AssignedRecdFieldSetter of RecdFieldInfo @@ -205,7 +205,8 @@ type CalledMeth<'T> = callerArgs: CallerArgs<'T> * allowParamArgs: bool * allowOutAndOptArgs: bool * - tyargsOpt: TType option -> + tyargsOpt: TType option * + staticTyOpt: TType option -> CalledMeth<'T> static member GetMethod: x: CalledMeth<'T> -> MethInfo @@ -302,6 +303,8 @@ type CalledMeth<'T> = member UsesParamArrayConversion: bool + member OptionalStaticType: TType option + member amap: ImportMap member infoReader: InfoReader @@ -338,7 +341,14 @@ val BuildILMethInfoCall: /// Make a call to a method info. Used by the optimizer and code generator to build /// calls to the type-directed solutions to member constraints. -val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: TType list -> args: Exprs -> Expr +val MakeMethInfoCall: + amap: ImportMap -> + m: range -> + minfo: MethInfo -> + minst: TType list -> + args: Exprs -> + staticTyOpt: TType option -> + Expr /// Build an expression that calls a given method info. /// This is called after overload resolution, and also to call other @@ -348,6 +358,7 @@ val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: T // minst: the instantiation to apply for a generic method // objArgs: the 'this' argument, if any // args: the arguments, if any +// staticTyOpt: the static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() val BuildMethodCall: tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) -> g: TcGlobals -> @@ -360,6 +371,7 @@ val BuildMethodCall: minst: TType list -> objArgs: Expr list -> args: Expr list -> + staticTyOpt: TType option -> Expr * TType /// Build a call to the System.Object constructor taking no arguments, diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 618c66df399..e317772dac4 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -346,7 +346,7 @@ module DispatchSlotChecking = // Always try to raise a target runtime error if we have a DIM. if reqdSlot.HasDefaultInterfaceImplementation then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m let maybeResolvedSlot = NameMultiMap.find dispatchSlot.LogicalName overridesKeyed @@ -743,6 +743,8 @@ module DispatchSlotChecking = yield SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, reqdProperties) ] + let IsStaticAbstractImpl (overrideBy: ValRef) = (not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl + /// Check that a type definition implements all its required interfaces after processing all declarations /// within a file. let CheckImplementationRelationAtEndOfInferenceScope (infoReader : InfoReader, denv, nenv, sink, tycon: Tycon, isImplementation) = @@ -767,10 +769,14 @@ module DispatchSlotChecking = let allImpls = List.zip allReqdTys slotImplSets // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked. + // + // Methods that are + // - Not static OR Static in the interface + // - override/default let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembers |> List.filter (fun overrideBy -> - overrideBy.IsInstanceMember && // exclude static - overrideBy.IsVirtualMember && // exclude non virtual (e.g. keep override/default). [4469] + (overrideBy.IsInstanceMember || IsStaticAbstractImpl overrideBy) && + overrideBy.IsVirtualMember && not overrideBy.IsDispatchSlotMember) let mustOverrideSomething reqdTy (overrideBy: ValRef) = @@ -918,10 +924,16 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv && not tycon.IsFSharpDelegateTycon then DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader, denv, nenv, sink, tycon, isImplementation) - + /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does -let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData) = +let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = + + let g = infoReader.g + if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm + checkLanguageFeatureAndRecover g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm + let minfos = match typToSearchForAbstractMembers with | _, Some(SlotImplSet(_, dispatchSlotsKeyed, _, _)) -> @@ -930,9 +942,16 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: GetIntrinsicMethInfosOfType infoReader (Some memberName.idText) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides bindm ty let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot) let valReprSynArities = SynInfo.AritiesOfArgs valSynData - let valReprSynArities = if List.isEmpty valReprSynArities then valReprSynArities else valReprSynArities.Tail + + // We only return everything if it's empty or if it's a non-instance member. + // If it's an instance member, we are getting rid of `this` (by only taking tail). + let valReprSynArities = + if List.isEmpty valReprSynArities || (not memberFlags.IsInstance) then + valReprSynArities + else + valReprSynArities.Tail let dispatchSlotsArityMatch = dispatchSlots |> List.filter (fun minfo -> minfo.NumArgs = valReprSynArities) - dispatchSlots, dispatchSlotsArityMatch + dispatchSlots, dispatchSlotsArityMatch /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does diff --git a/src/Compiler/Checking/MethodOverrides.fsi b/src/Compiler/Checking/MethodOverrides.fsi index b93b290f5d3..1c671e6bdb5 100644 --- a/src/Compiler/Checking/MethodOverrides.fsi +++ b/src/Compiler/Checking/MethodOverrides.fsi @@ -155,7 +155,8 @@ val GetAbstractMethInfosForSynMethodDecl: memberName: Ident * bindm: range * typToSearchForAbstractMembers: (TType * SlotImplSet option) * - valSynData: SynValInfo -> + valSynData: SynValInfo * + memberFlags: SynMemberFlags -> MethInfo list * MethInfo list /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 910cec2ab9e..56002f6e0e9 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -128,14 +128,6 @@ let ActivePatternElemsOfModuleOrNamespace g (modref: ModuleOrNamespaceRef) : Nam // Name Resolution Items //------------------------------------------------------------------------- -/// Detect a use of a nominal type, including type abbreviations. -/// -/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols -let (|AbbrevOrAppTy|_|) (ty: TType) = - match stripTyparEqns ty with - | TType_app (tcref, _, _) -> Some tcref - | _ -> None - /// Represents the item with which a named argument is associated. [] type ArgumentContainer = @@ -174,6 +166,9 @@ type Item = /// Represents the resolution of a name to an F# record or exception field. | RecdField of RecdFieldInfo + /// Represents the resolution of a name to an F# trait + | Trait of TraitConstraintInfo + /// Represents the resolution of a name to a union case field. | UnionCaseField of UnionCaseInfo * fieldIndex: int @@ -272,18 +267,27 @@ type Item = | Item.MethodGroup(_, FSMeth(_, _, v, _) :: _, _) -> v.DisplayNameCore | Item.MethodGroup(nm, _, _) -> nm |> ConvertValLogicalNameToDisplayNameCore | Item.CtorGroup(nm, _) -> nm |> DemangleGenericTypeName - | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) - | Item.DelegateCtor (AbbrevOrAppTy tcref) -> tcref.DisplayNameCore - | Item.Types(nm, _) -> nm |> DemangleGenericTypeName + | Item.FakeInterfaceCtor ty + | Item.DelegateCtor ty -> + match ty with + | AbbrevOrAppTy tcref -> tcref.DisplayNameCore + // This case is not expected + | _ -> "" | Item.UnqualifiedType(tcref :: _) -> tcref.DisplayNameCore + | Item.Types(nm, _) -> nm |> DemangleGenericTypeName | Item.TypeVar (nm, _) -> nm + | Item.Trait traitInfo -> traitInfo.MemberDisplayNameCore | Item.ModuleOrNamespaces(modref :: _) -> modref.DisplayNameCore | Item.ArgName (Some id, _, _, _) -> id.idText | Item.ArgName (None, _, _, _) -> "" | Item.SetterArg (id, _) -> id.idText | Item.CustomOperation (customOpName, _, _) -> customOpName | Item.CustomBuilder (nm, _) -> nm - | _ -> "" + | Item.ImplicitOp (id, _) -> id.idText + //| _ -> "" + // These singleton cases are not expected + | Item.ModuleOrNamespaces [] -> "" + | Item.UnqualifiedType [] -> "" member d.DisplayName = match d with @@ -1848,6 +1852,9 @@ let ItemsAreEffectivelyEqual g orig other = | Item.ModuleOrNamespaces modrefs1, Item.ModuleOrNamespaces modrefs2 -> modrefs1 |> List.exists (fun modref1 -> modrefs2 |> List.exists (fun r -> tyconRefDefnEq g modref1 r || fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef r)) + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName + | _ -> false /// Given the Item 'orig' - returns function 'other: Item -> bool', that will yield true if other and orig represents the same item and false - otherwise @@ -1855,6 +1862,7 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = match orig with | EntityUse tcref -> tyconRefDefnHash g tcref | Item.TypeVar (nm, _)-> hash nm + | Item.Trait traitInfo -> hash traitInfo.MemberLogicalName | ValUse vref -> valRefDefnHash g vref | ActivePatternCaseUse (_, _, idx)-> hash idx | MethodUse minfo -> minfo.ComputeHashCode() @@ -2142,6 +2150,7 @@ let CheckAllTyparsInferrable amap m item = let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) + | Item.Trait _ | Item.CtorGroup _ | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ @@ -2521,7 +2530,10 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf OneResult (success(resInfo, item, rest)) | None -> let isLookUpExpr = (lookupKind = LookupKind.Expr) - match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad) findFlag m ty with + match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad, true) findFlag m ty with + | Some (TraitItem (traitInfo :: _)) when isLookUpExpr -> + success [resInfo, Item.Trait traitInfo, rest] + | Some (PropertyItem psets) when isLookUpExpr -> let pinfos = psets |> ExcludeHiddenOfPropInfos g ncenv.amap m @@ -3649,7 +3661,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, _)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=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) @@ -3922,6 +3934,11 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso x.IsStatic = statics && IsILFieldInfoAccessible g amap m ad x) + let qinfos = + ncenv.InfoReader.GetTraitInfosInType None ty + |> List.filter (fun x -> + x.MemberFlags.IsInstance = not statics) + let pinfosIncludingUnseen = AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv None ad PreferOverrides m ty |> List.filter (fun x -> @@ -4085,6 +4102,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso List.map Item.RecdField rfinfos @ pinfoItems @ anonFields @ + List.map Item.Trait qinfos @ List.map Item.ILField finfos @ List.map Item.Event einfos @ List.map (ItemOfTy g) nestedTypes @ @@ -4441,7 +4459,15 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref - yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty ] + yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty + + // 'T.Ident: lookup a static something in a type parameter + // ^T.Ident: lookup a static something in a type parameter + match nenv.eTypars.TryGetValue id with + | true, tp -> + let ty = mkTyparTy tp + yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty + | _ -> () ] namespaces @ values @ staticSomethingInType @@ -4601,6 +4627,8 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: | _-> [] modsOrNs @ qualifiedFields +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (item: Item) : seq = seq { let g = ncenv.g @@ -4790,6 +4818,8 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( | _ -> () } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad statics plid (item: Item) ty = seq { let g = ncenv.g @@ -4838,6 +4868,8 @@ let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad sta yield! finfo.FieldType(amap, m) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) nenv m ad (modref: ModuleOrNamespaceRef) plid (item: Item) = let g = ncenv.g let mty = modref.ModuleOrNamespaceType @@ -4928,6 +4960,8 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f plid (modref: ModuleOrNamespaceRef) = let mty = modref.ModuleOrNamespaceType match plid with @@ -4938,6 +4972,8 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f pli PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) | _ -> Seq.empty +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let PartialResolveLongIdentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) plid f = seq { match plid with @@ -4950,6 +4986,8 @@ let PartialResolveLongIdentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) | [] -> () } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = seq { let g = ncenv.g diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 1494c029b85..d0be9852589 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -41,10 +41,6 @@ type ArgumentContainer = /// The named argument is a static parameter to a provided type. | Type of TyconRef -/// Detect a use of a nominal type, including type abbreviations. -/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols. -val (|AbbrevOrAppTy|_|): TType -> TyconRef option - type EnclosingTypeInst = TypeInst /// Represents an item that results from name resolution @@ -68,6 +64,9 @@ type Item = /// Represents the resolution of a name to an F# record or exception field. | RecdField of RecdFieldInfo + /// Represents the resolution of a name to an F# trait + | Trait of TraitConstraintInfo + /// Represents the resolution of a name to a union case field. | UnionCaseField of UnionCaseInfo * fieldIndex: int diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index efaafc194f3..ed7e92bf0ef 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -795,26 +795,49 @@ module PrintTypes = WordL.arrow ^^ (layoutTyparRefWithInfo denv env tp)) |> longConstraintPrefix] - and layoutTraitWithInfo denv env (TTrait(tys, nm, memFlags, argTys, retTy, _)) = + and layoutTraitWithInfo denv env traitInfo = + let g = denv.g + let (TTrait(tys, _, memFlags, _, _, _)) = traitInfo + let nm = traitInfo.MemberDisplayNameCore let nameL = ConvertValLogicalNameToDisplayLayout false (tagMember >> wordL) nm if denv.shortConstraints then WordL.keywordMember ^^ nameL else - let retTy = GetFSharpViewOfReturnType denv.g retTy + let retTy = traitInfo.GetReturnType(g) + let argTys = traitInfo.GetLogicalArgumentTypes(g) + let argTys, retTy = + match memFlags.MemberKind with + | SynMemberKind.PropertySet -> + match List.tryFrontAndBack argTys with + | Some res -> res + | None -> argTys, retTy + | _ -> + argTys, retTy + let stat = layoutMemberFlags memFlags - let tys = ListSet.setify (typeEquiv denv.g) tys + let tys = ListSet.setify (typeEquiv g) tys let tysL = match tys with | [ty] -> layoutTypeWithInfo denv env ty | tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys) - let argTysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argTys let retTyL = layoutReturnType denv env retTy let sigL = match argTys with + // Empty arguments indicates a non-indexer property constraint | [] -> retTyL - | _ -> curriedLayoutsL "->" [argTysL] retTyL - (tysL |> addColonL) --- bracketL (stat ++ (nameL |> addColonL) --- sigL) + | _ -> + let argTysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argTys + curriedLayoutsL "->" [argTysL] retTyL + let getterSetterL = + match memFlags.MemberKind with + | SynMemberKind.PropertyGet when not argTys.IsEmpty -> + wordL (tagKeyword "with") ^^ wordL (tagText "get") + | SynMemberKind.PropertySet -> + wordL (tagKeyword "with") ^^ wordL (tagText "set") + | _ -> + emptyL + (tysL |> addColonL) --- bracketL (stat ++ (nameL |> addColonL) --- sigL --- getterSetterL) /// Layout a unit of measure expression and layoutMeasure denv unt = @@ -1003,7 +1026,10 @@ module PrintTypes = else bracketL coreL --- nmL - let layoutTyparConstraint denv (tp, tpc) = + let layoutTrait denv traitInfo = + layoutTraitWithInfo denv SimplifyTypes.typeSimplificationInfo0 traitInfo + + let layoutTyparConstraint denv (tp, tpc) = match layoutConstraintWithInfo denv SimplifyTypes.typeSimplificationInfo0 (tp, tpc) with | h :: _ -> h | [] -> emptyL @@ -1122,7 +1148,20 @@ module PrintTypes = let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints layoutTypeWithInfoAndPrec denv env 2 ty --- cxsL - let prettyLayoutOfTypeNoConstraints denv ty = + let prettyLayoutOfTrait denv traitInfo = + let compgenId = SyntaxTreeOps.mkSynId Range.range0 unassignedTyparName + let fakeTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.None, true), false, TyparDynamicReq.No, [], false, false) + fakeTypar.SetConstraints [TyparConstraint.MayResolveMember(traitInfo, Range.range0)] + let ty, cxs = PrettyTypes.PrettifyType denv.g (mkTyparTy fakeTypar) + let env = SimplifyTypes.CollectInfo true [ty] cxs + // We expect one constraint, since we put one in. + match env.postfixConstraints with + | cx :: _ -> + // We expect at most one per constraint + sepListL emptyL (layoutConstraintWithInfo denv env cx) + | [] -> emptyL + + let prettyLayoutOfTypeNoConstraints denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 5 ty @@ -1342,7 +1381,9 @@ module PrintTastMemberOrVals = let prettyLayoutOfValOrMemberNoInst denv infoReader v = prettyLayoutOfValOrMember denv infoReader emptyTyparInst v |> snd -let layoutTyparConstraint denv x = x |> PrintTypes.layoutTyparConstraint denv +let layoutTrait denv x = x |> PrintTypes.layoutTrait denv + +let layoutTyparConstraint denv x = x |> PrintTypes.layoutTyparConstraint denv let outputType denv os x = x |> PrintTypes.layoutType denv |> bufferL os @@ -2512,6 +2553,8 @@ let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv +let prettyLayoutOfTrait denv x = x |> PrintTypes.prettyLayoutOfTrait denv + let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv let prettyLayoutOfTypar denv x = x |> PrintTypes.layoutTyparRef denv @@ -2621,4 +2664,3 @@ let minimalStringOfType denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty let denvMin = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false } showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 2 ty) - diff --git a/src/Compiler/Checking/NicePrint.fsi b/src/Compiler/Checking/NicePrint.fsi index f00cd3395e1..75c227b0d99 100644 --- a/src/Compiler/Checking/NicePrint.fsi +++ b/src/Compiler/Checking/NicePrint.fsi @@ -113,6 +113,8 @@ val stringOfTy: denv: DisplayEnv -> x: TType -> string val prettyLayoutOfType: denv: DisplayEnv -> x: TType -> Layout +val prettyLayoutOfTrait: denv: DisplayEnv -> x: TraitConstraintInfo -> Layout + val prettyLayoutOfTypeNoCx: denv: DisplayEnv -> x: TType -> Layout val prettyLayoutOfTypar: denv: DisplayEnv -> x: Typar -> Layout diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 60b5e2aac52..168a9bb7f09 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -1063,11 +1063,11 @@ let CompilePatternBasic | Some (ediCaptureMethInfo, ediThrowMethInfo) -> let edi, _ = BuildMethodCall tcVal g amap NeverMutates mMatch false - ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] + ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] None let e, _ = BuildMethodCall tcVal g amap NeverMutates mMatch false - ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] + ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] None mkCompGenSequential mMatch e (mkDefault (mMatch, resultTy)) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 035e5a237ce..031c5ae7991 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -651,7 +651,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = let visitTraitSolution info = match info with - | FSMethSln(_, vref, _) -> + | FSMethSln(_, vref, _, _) -> //printfn "considering %s..." vref.DisplayName if valRefInThisAssembly cenv.g.compilingFSharpCore vref && not (cenv.boundVals.ContainsKey(vref.Stamp)) then //printfn "recording %s..." vref.DisplayName diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index 949cc59de7c..80c7e52e7bf 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -260,7 +260,7 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = and ConvWitnessInfo cenv env m traitInfo = let g = cenv.g - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let env = { env with suppressWitnesses = true } // First check if this is a witness in ReflectedDefinition code if env.witnessesInScope.ContainsKey witnessInfo then @@ -712,7 +712,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let inWitnessPassingScope = not env.witnessesInScope.IsEmpty let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then - match env.witnessesInScope.TryGetValue traitInfo.TraitKey with + let witnessInfo = traitInfo.GetWitnessInfo() + match env.witnessesInScope.TryGetValue witnessInfo with | true, storage -> Some storage | _ -> None else diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index 4a689f48a0c..8e10990d11d 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -11,6 +11,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax @@ -122,9 +123,15 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let aenv = aenv.BindEquivTypars implTypars sigTypars (implTypars, sigTypars) ||> List.forall2 (fun implTypar sigTypar -> let m = sigTypar.Range - if implTypar.StaticReq <> sigTypar.StaticReq then - errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) + let check = + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + implTypar.StaticReq = TyparStaticReq.HeadType && sigTypar.StaticReq = TyparStaticReq.None + else + implTypar.StaticReq <> sigTypar.StaticReq + if check then + errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) + // Adjust the actual type parameter name to look like the signature implTypar.SetIdent (mkSynId implTypar.Range sigTypar.Id.idText) diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index fe44b9cf874..feaaf09e71b 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -9,6 +9,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import +open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals @@ -151,21 +152,26 @@ let rec GetImmediateInterfacesOfType skipUnref g amap m ty = // This measure-annotated type is considered to support the interfaces on its representation type A, // with the exception that // -// 1. we rewrite the IComparable and IEquatable interfaces, so that +// 1. Rewrite the IComparable and IEquatable interfaces, so that // IComparable --> IComparable> // IEquatable --> IEquatable> // -// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces +// 2. Omit any other interfaces that derive from IComparable and IEquatable interfaces // // This rule is conservative and only applies to IComparable and IEquatable interfaces. // -// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. +// We also: +// 3. Omit any interfaces in System.Numerics, since pretty much none of them are adequate for units of measure +// There are some exceptions, e.g. IAdditiveIdentity, but these are available3 by different routes in F# and for clarity +// it is better to imply omit all and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = [ - // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> + // Suppress any interfaces that derive from IComparable<_> or IEquatable<_> + // Suppress any interfaces in System.Numerics, since none of them are adequate for units of measure for intfTy in GetImmediateInterfacesOfType skipUnref g amap m reprTy do if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m intfTy) && - not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m intfTy) then + not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m intfTy) && + not (ExistsSystemNumericsTypeInInterfaceHierarchy skipUnref g amap m intfTy) then intfTy // NOTE: we should really only report the IComparable> interface for measure-annotated types @@ -180,6 +186,19 @@ and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = mkAppTy g.system_GenericIEquatable_tcref [ty] ] +// Check for any System.Numerics type in the interface hierarchy +and ExistsSystemNumericsTypeInInterfaceHierarchy skipUnref g amap m ity = + g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers && + ExistsInInterfaceHierarchy + (fun ity2 -> + match ity2 with + | AppTy g (tcref,_) -> + match tcref.CompilationPath.AccessPath with + | [("System", _); ("Numerics", _)] -> true + | _ -> false + | _ -> false) + skipUnref g amap m ity + // Check for IComparable, IEquatable and interfaces that derive from these and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m intfTy = ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m intfTy @@ -199,7 +218,7 @@ type AllowMultiIntfInstantiations = Yes | No /// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). /// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = +let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = let seenThisTycon = diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index f77563eae62..1c0612eb611 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -273,6 +273,70 @@ type ParamData = reflArgInfo: ReflectedArgInfo * ttype: TType +type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOutArg: bool * optArgInfo: OptionalArgInfo * callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo + +let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = + let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs + let reflArgInfo = + match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with + | Some b -> ReflectedArgInfo.Quote b + | None -> ReflectedArgInfo.None + let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty + let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty + let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs + let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs + let optArgInfo = + if isCalleeSideOptArg then + CalleeSide + elif isCallerSideOptArg then + let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs + match defaultParameterValueAttribute with + | None -> + // Do a type-directed analysis of the type to determine the default value to pass. + // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. + CallerSide (if isObjTy g ty then MissingValue else DefaultValue) + | Some attr -> + let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr + match defaultValue with + | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> + // the type of the default value does not match the type of the argument. + // Emit a warning, and ignore the DefaultParameterValue argument altogether. + warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) + NotOptional + | Some (Expr.Const (ConstToILFieldInit fi, _, _)) -> + // Good case - all is well. + CallerSide (Constant fi) + | _ -> + // Default value is not appropriate, i.e. not a constant. + // Compiler already gives an error in that case, so just ignore here. + NotOptional + else NotOptional + + let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs + let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs + let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs + + let callerInfo = + match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with + | false, false, false -> NoCallerInfo + | true, false, false -> CallerLineNumber + | false, true, false -> CallerFilePath + | false, false, true -> CallerMemberName + | false, true, true -> + match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with + | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> + warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) + CallerFilePath + | _ -> failwith "Impossible" + | _, _, _ -> + // if multiple caller info attributes are specified, pick the "wrong" one here + // so that we get an error later + match tryDestOptionTy g ty with + | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath + | _ -> CallerLineNumber + + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) + #if !NO_TYPEPROVIDERS type ILFieldInit with @@ -632,8 +696,9 @@ type MethInfo = /// Get the method name in DebuggerDisplayForm member x.DebuggerDisplayName = match x with - | ILMeth(_, y, _) -> "ILMeth: " + y.ILName - | FSMeth(_, _, vref, _) -> "FSMeth: " + vref.LogicalName + | ILMeth(_, y, _) -> y.DeclaringTyconRef.DisplayNameWithStaticParametersAndUnderscoreTypars + "::" + y.ILName + | FSMeth(_, AbbrevOrAppTy tcref, vref, _) -> tcref.DisplayNameWithStaticParametersAndUnderscoreTypars + "::" + vref.LogicalName + | FSMeth(_, _, vref, _) -> "??::" + vref.LogicalName #if !NO_TYPEPROVIDERS | ProvidedMeth(_, mi, _, m) -> "ProvidedMeth: " + mi.PUntaint((fun mi -> mi.Name), m) #endif @@ -670,7 +735,7 @@ type MethInfo = #endif | _ -> false - override x.ToString() = x.ApparentEnclosingType.ToString() + x.LogicalName + override x.ToString() = x.ApparentEnclosingType.ToString() + "::" + x.LogicalName /// Get the actual type instantiation of the declaring type associated with this use of the method. /// @@ -1105,72 +1170,11 @@ type MethInfo = if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath else CallerLineNumber - yield (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] | FSMeth(g, _, vref, _) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref - |> List.mapSquared (fun (ty, argInfo) -> - let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs - let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with - | Some b -> ReflectedArgInfo.Quote b - | None -> ReflectedArgInfo.None - let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty - let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty - let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs - let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs - let optArgInfo = - if isCalleeSideOptArg then - CalleeSide - elif isCallerSideOptArg then - let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs - match defaultParameterValueAttribute with - | None -> - // Do a type-directed analysis of the type to determine the default value to pass. - // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. - CallerSide (if isObjTy g ty then MissingValue else DefaultValue) - | Some attr -> - let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr - match defaultValue with - | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> - // the type of the default value does not match the type of the argument. - // Emit a warning, and ignore the DefaultParameterValue argument altogether. - warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) - NotOptional - | Some (Expr.Const (ConstToILFieldInit fi, _, _)) -> - // Good case - all is well. - CallerSide (Constant fi) - | _ -> - // Default value is not appropriate, i.e. not a constant. - // Compiler already gives an error in that case, so just ignore here. - NotOptional - else NotOptional - - let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs - let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs - let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs - - let callerInfo = - match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with - | false, false, false -> NoCallerInfo - | true, false, false -> CallerLineNumber - | false, true, false -> CallerFilePath - | false, false, true -> CallerMemberName - | false, true, true -> - match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with - | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> - warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) - CallerFilePath - | _ -> failwith "Impossible" - | _, _, _ -> - // if multiple caller info attributes are specified, pick the "wrong" one here - // so that we get an error later - match tryDestOptionTy g ty with - | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath - | _ -> CallerLineNumber - - (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) - + |> List.mapSquared (CrackParamAttribsInfo g) | DefaultStructCtor _ -> [[]] @@ -1187,7 +1191,7 @@ type MethInfo = | None -> ReflectedArgInfo.None let isOutArg = p.PUntaint((fun p -> p.IsOut && not p.IsIn), m) let isInArg = p.PUntaint((fun p -> p.IsIn && not p.IsOut), m) - yield (isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] #endif /// Get the signature of an abstract method slot. @@ -1224,9 +1228,9 @@ type MethInfo = // REVIEW: should we copy down attributes to slot params? let tcref = tcrefOfAppTy g x.ApparentEnclosingAppType let formalEnclosingTyparsOrig = tcref.Typars m - let formalEnclosingTypars = copyTypars formalEnclosingTyparsOrig + let formalEnclosingTypars = copyTypars false formalEnclosingTyparsOrig let _, formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars - let formalMethTypars = copyTypars x.FormalMethodTypars + let formalMethTypars = copyTypars false x.FormalMethodTypars let _, formalMethTyparTys = FixupNewTypars m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars let formalRetTy, formalParams = @@ -1288,7 +1292,8 @@ type MethInfo = #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) (ParamNameAndType(nmOpt, pty)) -> + (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun info (ParamNameAndType(nmOpt, pty)) -> + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty))) /// Get the ParamData objects for the parameters of a MethInfo diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index ed9964db644..63a24eb6502 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -136,6 +136,18 @@ type ParamData = reflArgInfo: ReflectedArgInfo * ttype: TType +// Adhoc information - could be unified with ParamData +type ParamAttribs = + | ParamAttribs of + isParamArrayArg: bool * + isInArg: bool * + isOutArg: bool * + optArgInfo: OptionalArgInfo * + callerInfo: CallerInfo * + reflArgInfo: ReflectedArgInfo + +val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs + /// Describes an F# use of an IL type, including the type instantiation associated with the type at a particular usage point. [] type ILTypeInfo = @@ -500,8 +512,7 @@ type MethInfo = member GetCustomAttrs: unit -> ILAttributes /// Get the parameter attributes of a method info, which get combined with the parameter names and types - member GetParamAttribs: - amap: ImportMap * m: range -> (bool * bool * bool * OptionalArgInfo * CallerInfo * ReflectedArgInfo) list list + member GetParamAttribs: amap: ImportMap * m: range -> ParamAttribs list list /// Get the ParamData objects for the parameters of a MethInfo member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> ParamData list list diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs index 5ba6c4b50a0..a0c022a01a8 100644 --- a/src/Compiler/CodeGen/EraseClosures.fs +++ b/src/Compiler/CodeGen/EraseClosures.fs @@ -366,7 +366,7 @@ let convReturnInstr ty instr = | I_ret -> [ I_box ty; I_ret ] | I_call (_, mspec, varargs) -> [ I_call(Normalcall, mspec, varargs) ] | I_callvirt (_, mspec, varargs) -> [ I_callvirt(Normalcall, mspec, varargs) ] - | I_callconstraint (_, ty, mspec, varargs) -> [ I_callconstraint(Normalcall, ty, mspec, varargs) ] + | I_callconstraint (callvirt, _, ty, mspec, varargs) -> [ I_callconstraint(callvirt, Normalcall, ty, mspec, varargs) ] | I_calli (_, csig, varargs) -> [ I_calli(Normalcall, csig, varargs) ] | _ -> [ instr ] @@ -573,6 +573,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let nowApplyMethDef = mkILGenericVirtualMethod ( "Specialize", + ILCallingConv.Instance, ILMemberAccess.Public, addedGenParams (* method is generic over added ILGenericParameterDefs *) , [], @@ -707,7 +708,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let convil = convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode) let nowApplyMethDef = - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "Invoke", ILMemberAccess.Public, nowParams, diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 28d06545589..753e7772676 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1389,7 +1389,7 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = // Find the 'this' argument type if any let thisTy, flatArgInfos = if isCtor then - (GetFSharpViewOfReturnType g returnTy), flatArgInfos + GetFSharpViewOfReturnType g returnTy, flatArgInfos else match flatArgInfos with | [] -> error (InternalError("This instance method '" + vref.LogicalName + "' has no arguments", m)) @@ -1408,22 +1408,20 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = warning (InternalError(msg, m)) else - List.iter2 - (fun gtp ty2 -> - if not (typeEquiv g (mkTyparTy gtp) ty2) then - warning ( - InternalError( - "CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " - + gtp.Name - + "#" - + string gtp.Stamp - + " and list from 'this' pointer contained " - + (showL (typeL ty2)), - m - ) - )) - ctps - thisArgTys + (ctps, thisArgTys) + ||> List.iter2 (fun gtp ty2 -> + if not (typeEquiv g (mkTyparTy gtp) ty2) then + warning ( + InternalError( + "CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " + + gtp.Name + + "#" + + string gtp.Stamp + + " and list from 'this' pointer contained " + + (showL (typeL ty2)), + m + ) + )) let methodArgTys, paramInfos = List.unzip flatArgInfos @@ -3985,7 +3983,8 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr = and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = let g = cenv.g - let storage = TryStorageForWitness g eenv traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let storage = TryStorageForWitness g eenv witnessInfo match storage with | None -> @@ -4001,7 +4000,8 @@ and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = let eenv = { eenv with suppressWitnesses = true } GenExpr cenv cgbuf eenv arg Continue | Some storage -> - let ty = GenWitnessTy g traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage None and GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo = @@ -4283,13 +4283,15 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = else Normalcall - let useICallVirt = virtualCall || useCallVirt cenv boxity mspec isBaseCall + let useICallVirt = + (virtualCall || useCallVirt cenv boxity mspec isBaseCall) + && mspec.MethodRef.CallingConv.IsInstance let callInstr = match valUseFlags with | PossibleConstrainedCall ty -> let ilThisTy = GenType cenv m eenv.tyenv ty - I_callconstraint(isTailCall, ilThisTy, mspec, None) + I_callconstraint(useICallVirt, isTailCall, ilThisTy, mspec, None) | _ -> if newobj then I_newobj(mspec, None) elif useICallVirt then I_callvirt(isTailCall, mspec, None) @@ -5354,7 +5356,10 @@ and GenILCall let ilMethArgTys = GenTypeArgs cenv m eenv.tyenv methArgTys let ilReturnTys = GenTypes cenv m eenv.tyenv returnTys let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) - let useICallVirt = virt || useCallVirt cenv boxity ilMethSpec isBaseCall + + let useICallVirt = + (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) + && ilMethRef.CallingConv.IsInstance // Load the 'this' pointer to pass to the superclass constructor. This argument is not // in the expression tree since it can't be treated like an ordinary value @@ -5370,7 +5375,7 @@ and GenILCall match ccallInfo with | Some objArgTy -> let ilObjArgTy = GenType cenv m eenv.tyenv objArgTy - I_callconstraint(tail, ilObjArgTy, ilMethSpec, None) + I_callconstraint(useICallVirt, tail, ilObjArgTy, ilMethSpec, None) | None -> if useICallVirt then I_callvirt(tail, ilMethSpec, None) @@ -5405,14 +5410,16 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp let witness = if generateWitnesses then - TryStorageForWitness g eenv traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + TryStorageForWitness g eenv witnessInfo else None match witness with | Some storage -> - let ty = GenWitnessTy g traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let ty = GenWitnessTy g witnessInfo let argExprs = if argExprs.Length = 0 then [ mkUnit g m ] else argExprs GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage (Some([], argExprs, m, sequel)) @@ -5421,13 +5428,13 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp // If witnesses are available, we should now always find trait witnesses in scope assert not generateWitnesses - let minfoOpt = + let exprOpt = CommitOperationResult(ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) - match minfoOpt with + match exprOpt with | None -> let exnArg = - mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberName)) + mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberLogicalName)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) let replacementExpr = mkThrow m (tyOfExpr g expr) exnExpr @@ -5668,7 +5675,7 @@ and GenFormalSlotsig m cenv eenv slotsig = let ilRet = GenFormalReturnType m cenv eenvForSlotSig returnTy ilTy, ilParams, ilRet -and GenOverridesSpec cenv eenv slotsig m = +and GenOverridesSpec cenv eenv slotsig m isInstance = let (TSlotSig (nameOfOverridenMethod, _, _, methodTypars, _, _)) = slotsig let ilOverrideTy, ilOverrideParams, ilOverrideRet = @@ -5676,10 +5683,16 @@ and GenOverridesSpec cenv eenv slotsig m = let ilOverrideTyRef = ilOverrideTy.TypeRef + let callingConv = + if isInstance then + ILCallingConv.Instance + else + ILCallingConv.Static + let ilOverrideMethRef = mkILMethRef ( ilOverrideTyRef, - ILCallingConv.Instance, + callingConv, nameOfOverridenMethod, List.length (DropErasedTypars methodTypars), typesOfILParams ilOverrideParams, @@ -5742,8 +5755,8 @@ and GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) = else nameOfOverridenMethod -and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m = - let ilOverridesSpec = GenOverridesSpec cenv eenv slotsig m +and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m isInstance = + let ilOverridesSpec = GenOverridesSpec cenv eenv slotsig m isInstance let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) @@ -5760,13 +5773,22 @@ and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m = let ilOverrideMethGenericArgs = mkILFormalGenericArgs 0 ilOverrideMethGenericParams let ilOverrideBy = - mkILInstanceMethSpecInTy ( - ilTyForOverriding, - nameOfOverridingMethod, - typesOfILParams ilParamsOfOverridingMethod, - ilReturnOfOverridingMethod.Type, - ilOverrideMethGenericArgs - ) + if isInstance then + mkILInstanceMethSpecInTy ( + ilTyForOverriding, + nameOfOverridingMethod, + typesOfILParams ilParamsOfOverridingMethod, + ilReturnOfOverridingMethod.Type, + ilOverrideMethGenericArgs + ) + else + mkILStaticMethSpecInTy ( + ilTyForOverriding, + nameOfOverridingMethod, + typesOfILParams ilParamsOfOverridingMethod, + ilReturnOfOverridingMethod.Type, + ilOverrideMethGenericArgs + ) { Overrides = ilOverridesSpec @@ -5789,7 +5811,9 @@ and fixupMethodImplFlags (mdef: ILMethodDef) = ) .WithNewSlot -and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = +and fixupStaticAbstractSlotFlags (mdef: ILMethodDef) = mdef.WithHideBySig(true) + +and GenObjectExprMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = let g = cenv.g let (TObjExprMethod (slotsig, attribs, methTyparsOfOverridingMethod, methParams, methBodyExpr, m)) = @@ -5829,11 +5853,12 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod CodeGenMethodForExpr cenv cgbuf.mgbuf ([], nameOfOverridenMethod, eenvForMeth, 0, selfArgOpt, methBodyExpr, sequel) let nameOfOverridingMethod, methodImplGenerator = - GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range + GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range true let mdef = mkILGenericVirtualMethod ( nameOfOverridingMethod, + ILCallingConv.Instance, ILMemberAccess.Public, GenGenericParams cenv eenvUnderTypars methTyparsOfOverridingMethod, ilParamsOfOverridingMethod, @@ -6015,7 +6040,13 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel (ilArgTys, argVals) ||> List.map2 (fun ty v -> mkILParamNamed (v.LogicalName, ty)) - mkILNonGenericVirtualMethod (imethName, ILMemberAccess.Public, ilParams, mkILReturn ilRetTy, MethodBody.IL(notlazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + imethName, + ILMemberAccess.Public, + ilParams, + mkILReturn ilRetTy, + MethodBody.IL(notlazy ilCode) + ) ] let mimpls = @@ -6036,7 +6067,9 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel | _ -> error (InternalError(sprintf "expected method %s not found" imethName, m)) let slotsig = implementedMeth.GetSlotSig(amap, m) - let ilOverridesSpec = GenOverridesSpec cenv eenvinner slotsig m + + let ilOverridesSpec = + GenOverridesSpec cenv eenvinner slotsig m mdef.CallingConv.IsInstance let ilOverrideBy = mkILInstanceMethSpecInTy (ilCloTy, imethName, mdef.ParameterTypes, mdef.Return.Type, []) @@ -6220,7 +6253,7 @@ and GenObjectExpr cenv cgbuf eenvouter objExpr (baseType, baseValOpt, basecall, let genMethodAndOptionalMethodImpl tmethod useMethodImpl = [ for (useMethodImpl, methodImplGeneratorFunction, methTyparsOfOverridingMethod), mdef in - GenObjectMethod cenv eenvinner cgbuf useMethodImpl tmethod do + GenObjectExprMethod cenv eenvinner cgbuf useMethodImpl tmethod do let mimpl = (if useMethodImpl then Some(methodImplGeneratorFunction (ilTyForOverriding, methTyparsOfOverridingMethod)) @@ -6371,7 +6404,7 @@ and GenSequenceExpr GenSequel cenv eenv.cloc cgbuf Return), m) - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "GetFreshEnumerator", ILMemberAccess.Public, [], @@ -6384,13 +6417,19 @@ and GenSequenceExpr let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "Close", eenvinner, 1, None, closeExpr, discardAndReturnVoid) - mkILNonGenericVirtualMethod ("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL(lazy ilCode)) let checkCloseMethod = let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_CheckClose", eenvinner, 1, None, checkCloseExpr, Return) - mkILNonGenericVirtualMethod ("get_CheckClose", ILMemberAccess.Public, [], mkILReturn g.ilg.typ_Bool, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + "get_CheckClose", + ILMemberAccess.Public, + [], + mkILReturn g.ilg.typ_Bool, + MethodBody.IL(lazy ilCode) + ) let generateNextMethod = // the 'next enumerator' byref arg is at arg position 1 @@ -6403,13 +6442,19 @@ and GenSequenceExpr let ilCode = MethodBody.IL(lazy (CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "GenerateNext", eenvinner, 2, None, generateNextExpr, Return))) - mkILNonGenericVirtualMethod ("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) + mkILNonGenericVirtualInstanceMethod ("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) let lastGeneratedMethod = let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_LastGenerated", eenvinner, 1, None, exprForValRef m currvref, Return) - mkILNonGenericVirtualMethod ("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + "get_LastGenerated", + ILMemberAccess.Public, + [], + mkILReturn ilCloSeqElemTy, + MethodBody.IL(lazy ilCode) + ) |> AddNonUserCompilerGeneratedAttribs g let ilCtorBody = @@ -6605,6 +6650,7 @@ and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars expr [ mkILGenericVirtualMethod ( "DirectInvoke", + ILCallingConv.Instance, ILMemberAccess.Assembly, ilDirectGenericParams, ilDirectWitnessParams, @@ -7092,26 +7138,76 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod (slotsig, _attribs CG.EmitInstr cgbuf (pop 2) (Push [ ilCtxtDelTy ]) (I_newobj(ilDelegeeCtorMethOuter, None)) GenSequel cenv eenvouter.cloc cgbuf sequel -/// Generate statically-resolved conditionals used for type-directed optimizations. -and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = - // Note: during IlxGen, even if answer is StaticOptimizationAnswer.Unknown we discard the static optimization - // This means 'when ^T : ^T' is discarded if not resolved. - // - // This doesn't apply when witnesses are available. In that case, "when ^T : ^T" is resolved as 'Yes', - // this is because all the uses of "when ^T : ^T" in FSharp.Core (e.g. for are for deciding between the - // witness-based implementation and the legacy dynamic implementation, e.g. - // - // let inline ( * ) (x: ^T) (y: ^U) : ^V = - // MultiplyDynamic<(^T),(^U),(^V)> x y - // ... - // when ^T : ^T = ((^T or ^U): (static member (*) : ^T * ^U -> ^V) (x,y)) - // - // When witnesses are not available we use the dynamic implementation. +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprIsTraitCall expr = + match expr with + | Expr.Op (TOp.TraitCall _, _, _, _) -> true + | _ -> false + +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprIndicatesGenericStaticConstrainedCall g expr = + match expr with + | Expr.Val (vref, PossibleConstrainedCall ty, _) -> + vref.IsMember + && not vref.MemberInfo.Value.MemberFlags.IsInstance + && isTyparTy g ty + | Expr.Op (TOp.ILCall (valUseFlag = PossibleConstrainedCall ty; ilMethRef = ilMethRef), _, _, _) -> + not ilMethRef.CallingConv.IsInstance && isTyparTy g ty + | _ -> false + +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprRequiresWitness cenv m expr = + let g = cenv.g + + match expr with + | Expr.Op (TOp.TraitCall (traitInfo), _, _, _) -> + ConstraintSolver.CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs cenv.tcVal g cenv.amap m traitInfo + |> CommitOperationResult + | _ -> false + +/// Generate statically-resolved conditionals used for type-directed optimizations in FSharp.Core only. +and GenStaticOptimization cenv cgbuf eenv (staticConditions, e2, e3, m) sequel = + let g = cenv.g let e = + // See 'decideStaticOptimizationConstraint' + // + // For ^T : ^T we can additionally decide the conditional positively if either + // 1. we're in code generating witnesses + // 2. e2 uses a trait call of some kind + // 2. e2 doesn't require a witness let generateWitnesses = ComputeGenerateWitnesses cenv.g eenv - if DecideStaticOptimizations cenv.g constraints generateWitnesses = StaticOptimizationAnswer.Yes then + let canDecideTyparEqn = + let usesTraitOrConstrainedCall = + (false, e2) + ||> FoldExpr + { ExprFolder0 with + exprIntercept = + (fun _exprF noInterceptF z expr -> + z + || ExprIsTraitCall expr + || ExprIndicatesGenericStaticConstrainedCall g expr + || noInterceptF false expr) + } + + if usesTraitOrConstrainedCall then + if generateWitnesses then + true + else + let requiresWitness = + (false, e2) + ||> FoldExpr + { ExprFolder0 with + exprIntercept = + (fun _exprF noInterceptF z expr -> z || ExprRequiresWitness cenv m expr || noInterceptF false expr) + } + + not requiresWitness + else + false + + if DecideStaticOptimizations cenv.g staticConditions canDecideTyparEqn = StaticOptimizationAnswer.Yes then e2 else e3 @@ -9093,7 +9189,6 @@ and GenMethodForBinding let mdef = match v.MemberInfo with | Some memberInfo when not v.IsExtensionMember -> - let ilMethTypars = ilTypars |> List.skip mspec.DeclaringType.GenericArgs.Length if memberInfo.MemberFlags.MemberKind = SynMemberKind.Constructor then @@ -9118,8 +9213,16 @@ and GenMethodForBinding else let mdef = if not compileAsInstance then - mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + if not memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + else // We want to get potential fixups and hidebysig for abstract statics: + let flagFixups = [ fixupStaticAbstractSlotFlags ] + + let mdef = + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + mdef elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || memberInfo.MemberFlags.IsOverrideOrExplicitImpl @@ -9127,8 +9230,22 @@ and GenMethodForBinding let flagFixups = ComputeFlagFixupsForMemberBinding cenv v + let cconv = + if memberInfo.MemberFlags.IsInstance then + ILCallingConv.Instance + else + ILCallingConv.Static + let mdef = - mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + mkILGenericVirtualMethod ( + mspec.Name, + cconv, + ILMemberAccess.Public, + ilMethTypars, + ilParams, + ilReturn, + ilMethodBody + ) let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups @@ -10178,7 +10295,7 @@ and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThat mkLdarg0 mkLdarg 1us if tcref.IsStructOrEnumTycon then - I_callconstraint(Normalcall, ilThisTy, mspec, None) + I_callconstraint(true, Normalcall, ilThisTy, mspec, None) else I_callvirt(Normalcall, mspec, None) mkLdcInt32 0 @@ -10188,7 +10305,7 @@ and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThat let ilMethodBody = mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, None) - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "Equals", ILMemberAccess.Public, [ mkILParamNamed ("obj", g.ilg.typ_Object) ], @@ -10271,6 +10388,7 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = let mdef = mkILGenericVirtualMethod ( vref.CompiledName g.CompilerGlobalState, + mspec.CallingConv, ILMemberAccess.Public, ilMethTypars, ilParams, @@ -10280,16 +10398,9 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = let mdef = fixupVirtualSlotFlags mdef - let mdef = - if mdef.IsVirtual then - mdef - .WithFinal(memberInfo.MemberFlags.IsFinal) - .WithAbstract(memberInfo.MemberFlags.IsDispatchSlot) - else - mdef - let mdef = mdef + .WithFinal(memberInfo.MemberFlags.IsFinal) .WithPreserveSig(hasPreserveSigImplFlag) .WithSynchronized(hasSynchronizedImplFlag) .WithNoInlining(hasNoInliningFlag) @@ -10391,7 +10502,7 @@ and GenPrintingMethod cenv eenv methName ilThisTy m = mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, eenv.imports) let mdef = - mkILNonGenericVirtualMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody) + mkILNonGenericVirtualInstanceMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody) let mdef = mdef.With(customAttrs = mkILCustomAttrs [ g.CompilerGeneratedAttribute ]) yield mdef @@ -10490,7 +10601,6 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = match vref.ValReprInfo with | Some _ -> - let memberParentTypars, memberMethodTypars = match PartitionValRefTypars g vref with | Some (_, memberParentTypars, memberMethodTypars, _, _) -> @@ -10501,11 +10611,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let eenvUnderTypars = EnvForTypars memberParentTypars eenv let _, methodImplGenerator = - GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m + GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance if useMethodImpl then yield methodImplGenerator (ilThisTy, memberMethodTypars) - | _ -> () ] diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index acf3da6e515..a6e0450af3a 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -788,12 +788,13 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | UnresolvedOverloading (denv, callerArgs, failure, m) -> + let g = denv.g // extract eventual information (return type and type parameters) // from ConstraintTraitInfo let knownReturnType, genericParameterTypes = match failure with | NoOverloadsFound(cx = Some cx) - | PossibleCandidates(cx = Some cx) -> cx.ReturnType, cx.ArgumentTypes + | PossibleCandidates(cx = Some cx) -> Some(cx.GetReturnType(g)), cx.GetCompiledArgumentTypes() | _ -> None, [] // prepare message parts (known arguments, known return type, known generic parameters) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 60e5702d449..0f7d78b1127 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -463,11 +463,13 @@ parsMultiArgumentGenericTypeFormDeprecated,"The syntax '(typ,...,typ) ident' is 618,parsInvalidLiteralInType,"Invalid literal in type" 619,parsUnexpectedOperatorForUnitOfMeasure,"Unexpected infix operator in unit-of-measure expression. Legal operators are '*', '/' and '^'." 620,parsUnexpectedIntegerLiteralForUnitOfMeasure,"Unexpected integer literal in unit-of-measure expression" -621,parsUnexpectedTypeParameter,"Syntax error: unexpected type parameter specification" +#621,parsUnexpectedTypeParameter,"Syntax error: unexpected type parameter specification" 622,parsMismatchedQuotationName,"Mismatched quotation operator name, beginning with '%s'" 623,parsActivePatternCaseMustBeginWithUpperCase,"Active pattern case identifiers must begin with an uppercase letter" 624,parsActivePatternCaseContainsPipe,"The '|' character is not permitted in active pattern case identifiers" 625,parsIllegalDenominatorForMeasureExponent,"Denominator must not be 0 in unit-of-measure exponent" +626,parsIncompleteTyparExpr1,"Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name)" +626,parsIncompleteTyparExpr2,"Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name)" parsNoEqualShouldFollowNamespace,"No '=' symbol should follow a 'namespace' declaration" parsSyntaxModuleStructEndDeprecated,"The syntax 'module ... = struct .. end' is not used in F# code. Consider using 'module ... = begin .. end'" parsSyntaxModuleSigEndDeprecated,"The syntax 'module ... : sig .. end' is not used in F# code. Consider using 'module ... = begin .. end'" @@ -1539,6 +1541,8 @@ featureStructActivePattern,"struct representation for active patterns" featureRelaxWhitespace2,"whitespace relaxation v2" featureReallyLongList,"list literals of any size" featureErrorOnDeprecatedRequireQualifiedAccess,"give error on deprecated access of construct with RequireQualifiedAccess attribute" +featureInterfacesWithAbstractStaticMembers,"static abstract interface members" +featureSelfTypeConstraints,"self type constraints" featureRequiredProperties,"support for required properties" featureInitProperties,"support for consuming init properties" featureLowercaseDUWhenRequireQualifiedAccess,"Allow lowercase DU when RequireQualifiedAccess attribute" @@ -1631,4 +1635,12 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3522,tcAnonRecdDuplicateFieldId,"The field '%s' appears multiple times in this record expression." 3523,tcAnonRecdTypeDuplicateFieldId,"The field '%s' appears multiple times in this anonymous record type." 3524,parsExpectingExpressionInTuple,"Expecting expression" -3545,tcMissingRequiredMembers,"The following required properties have to be initalized:%s" \ No newline at end of file +3530,tcTraitIsStatic,"Trait '%s' is static" +3531,tcTraitIsNotStatic,"Trait '%s' is not static" +3532,tcTraitMayNotUseComplexThings,"A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" +3533,tcInvalidSelfConstraint,"Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints." +3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." +3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." +3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"'%s' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." +3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." +3545,tcMissingRequiredMembers,"The following required properties have to be initalized:%s" diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 03401823c1a..683dddd2e4f 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -52,6 +52,8 @@ type LanguageFeature = | RequiredPropertiesSupport | InitPropertiesSupport | LowercaseDUWhenRequireQualifiedAccess + | InterfacesWithAbstractStaticMembers + | SelfTypeConstraints /// LanguageVersion management type LanguageVersion(versionText) = @@ -117,6 +119,8 @@ type LanguageVersion(versionText) = LanguageFeature.RequiredPropertiesSupport, previewVersion LanguageFeature.InitPropertiesSupport, previewVersion LanguageFeature.LowercaseDUWhenRequireQualifiedAccess, previewVersion + LanguageFeature.InterfacesWithAbstractStaticMembers, previewVersion + LanguageFeature.SelfTypeConstraints, previewVersion ] static let defaultLanguageVersion = LanguageVersion("default") @@ -219,6 +223,8 @@ type LanguageVersion(versionText) = | LanguageFeature.RequiredPropertiesSupport -> FSComp.SR.featureRequiredProperties () | LanguageFeature.InitPropertiesSupport -> FSComp.SR.featureInitProperties () | LanguageFeature.LowercaseDUWhenRequireQualifiedAccess -> FSComp.SR.featureLowercaseDUWhenRequireQualifiedAccess () + | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureInterfacesWithAbstractStaticMembers () + | LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints () /// Get a version string associated with the given feature. member _.GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 1e2c977a4ad..71673cb05e3 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -42,6 +42,8 @@ type LanguageFeature = | RequiredPropertiesSupport | InitPropertiesSupport | LowercaseDUWhenRequireQualifiedAccess + | InterfacesWithAbstractStaticMembers + | SelfTypeConstraints /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index 58b57ddace0..dee03bb5f7e 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -260,7 +260,7 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL member _.SupportsFeature featureId = langVersion.SupportsFeature featureId - member _.CheckLanguageFeatureErrorRecover featureId range = + member _.CheckLanguageFeatureAndRecover featureId range = FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureAndRecover langVersion featureId range static member FromFunction(reportLibraryOnlyFeatures, langVersion, f: 'Char[] * int * int -> int) : LexBuffer<'Char> = diff --git a/src/Compiler/Facilities/prim-lexing.fsi b/src/Compiler/Facilities/prim-lexing.fsi index 290b48b53e8..e662c1edf37 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -134,7 +134,7 @@ type internal LexBuffer<'Char> = member SupportsFeature: LanguageFeature -> bool /// Logs a recoverable error if a language feature is unsupported, at the specified range. - member CheckLanguageFeatureErrorRecover: LanguageFeature -> range -> unit + member CheckLanguageFeatureAndRecover: LanguageFeature -> range -> unit /// Create a lex buffer suitable for Unicode lexing that reads characters from the given array. /// Important: does take ownership of the array. diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index e3091ec71fe..e3c120d0697 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -28,13 +28,13 @@ let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive // copy of it. - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] None //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] disposeExpr else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) @@ -44,7 +44,7 @@ let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with | [x] -> x | _ -> error(InternalError("no " + name + " method found on Collector", m)) - let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args + let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args None expr let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 368993e7cc2..62e8078e8cb 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -2385,15 +2385,19 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.LetRec (binds, bodyExpr, m, _) -> OptimizeLetRec cenv env (binds, bodyExpr, m) - | Expr.StaticOptimization (constraints, expr2, expr3, m) -> - let expr2R, e2info = OptimizeExpr cenv env expr2 - let expr3R, e3info = OptimizeExpr cenv env expr3 - Expr.StaticOptimization (constraints, expr2R, expr3R, m), - { TotalSize = min e2info.TotalSize e3info.TotalSize - FunctionSize = min e2info.FunctionSize e3info.FunctionSize - HasEffect = e2info.HasEffect || e3info.HasEffect - MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative - Info= UnknownValue } + | Expr.StaticOptimization (staticConditions, expr2, expr3, m) -> + let d = DecideStaticOptimizations g staticConditions false + if d = StaticOptimizationAnswer.Yes then OptimizeExpr cenv env expr2 + elif d = StaticOptimizationAnswer.No then OptimizeExpr cenv env expr3 + else + let expr2R, e2info = OptimizeExpr cenv env expr2 + let expr3R, e3info = OptimizeExpr cenv env expr3 + Expr.StaticOptimization (staticConditions, expr2R, expr3R, m), + { TotalSize = min e2info.TotalSize e3info.TotalSize + FunctionSize = min e2info.FunctionSize e3info.FunctionSize + HasEffect = e2info.HasEffect || e3info.HasEffect + MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative + Info= UnknownValue } | Expr.Link _eref -> assert ("unexpected reclink" = "") diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index bfdb97fa0cc..fafdbf0e58c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -46,6 +46,7 @@ open FSharp.Compiler.Text.Layout open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.AbstractIL open System.Reflection.PortableExecutable @@ -463,6 +464,8 @@ type internal TypeCheckInfo match cnrs, membersByResidue with + // Exact resolution via SomeType.$ or SomeType.$ + // // If we're looking for members using a residue, we'd expect only // a single item (pick the first one) and we need the residue (which may be "") | CNR (Item.Types (_, ty :: _), _, denv, nenv, ad, m) :: _, Some _ -> @@ -473,6 +476,15 @@ type internal TypeCheckInfo let items = List.map ItemWithNoInst items ReturnItemsOfType items g denv m filterCtors + // Exact resolution via 'T.$ + | CNR (Item.TypeVar (_, tp), _, denv, nenv, ad, m) :: _, Some _ -> + let targets = + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + + let items = ResolveCompletionsInType ncenv nenv targets m ad true (mkTyparTy tp) + let items = List.map ItemWithNoInst items + ReturnItemsOfType items g denv m filterCtors + // Value reference from the name resolution. Primarily to disallow "let x.$ = 1" // In most of the cases, value references can be obtained from expression typings or from environment, // so we wouldn't have to handle values here. However, if we have something like: @@ -721,27 +733,21 @@ type internal TypeCheckInfo let items = items |> RemoveExplicitlySuppressed g items, nenv.DisplayEnv, m - /// Resolve a location and/or text to items. - // Three techniques are used - // - look for an exact known name resolution from type checking - // - use the known type of an expression, e.g. (expr).Name, to generate an item list - // - lookup an entire name in the name resolution environment, e.g. A.B.Name, to generate an item list - // - // The overall aim is to resolve as accurately as possible based on what we know from type inference - - let GetBaseClassCandidates = - function + /// Is the item suitable for completion at "inherits $" + let IsInheritsCompletionCandidate item = + match item with | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, ty :: _) when (isClassTy g ty) && not (isSealedTy g ty) -> true + | Item.Types (_, ty :: _) when isClassTy g ty && not (isSealedTy g ty) -> true | _ -> false - let GetInterfaceCandidates = - function + /// Is the item suitable for completion at "interface $" + let IsInterfaceCompletionCandidate item = + match item with | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, ty :: _) when (isInterfaceTy g ty) -> true + | Item.Types (_, ty :: _) when isInterfaceTy g ty -> true | _ -> false - // Return only items with the specified name + /// Return only items with the specified name, modulo "Attribute" for type completions let FilterDeclItemsByResidue (getItem: 'a -> Item) residue (items: 'a list) = let attributedResidue = residue + "Attribute" @@ -770,7 +776,7 @@ type internal TypeCheckInfo /// Post-filter items to make sure they have precisely the right name /// This also checks that there are some remaining results /// exactMatchResidueOpt = Some _ -- means that we are looking for exact matches - let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt: _ option) check (items: 'a list, denv, m) = + let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt: string option) check (items: 'a list, denv, m) = // can throw if type is in located in non-resolved CCU: i.e. bigint if reference to System.Numerics is absent let inline safeCheck item = try @@ -813,17 +819,43 @@ type internal TypeCheckInfo if p >= 0 then Some p else None + /// Build a CompetionItem let CompletionItem (ty: ValueOption) (assemblySymbol: ValueOption) (item: ItemWithInst) = let kind = match item.Item with - | Item.MethodGroup (_, minfo :: _, _) -> CompletionItemKind.Method minfo.IsExtensionMember + | Item.FakeInterfaceCtor _ + | Item.DelegateCtor _ + | Item.CtorGroup _ -> CompletionItemKind.Method false + | Item.MethodGroup (_, minfos, _) -> + match minfos with + | [] -> CompletionItemKind.Method false + | minfo :: _ -> CompletionItemKind.Method minfo.IsExtensionMember | Item.RecdField _ | Item.Property _ -> CompletionItemKind.Property | Item.Event _ -> CompletionItemKind.Event | Item.ILField _ | Item.Value _ -> CompletionItemKind.Field | Item.CustomOperation _ -> CompletionItemKind.CustomOperation - | _ -> CompletionItemKind.Other + // These items are not given a completion kind. This could be reviewed + | Item.AnonRecdField _ + | Item.ActivePatternResult _ + | Item.CustomOperation _ + | Item.CtorGroup _ + | Item.ExnCase _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.Trait _ + | Item.TypeVar _ + | Item.Types _ + | Item.UnionCase _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Value _ + | Item.NewDef _ + | Item.SetterArg _ + | Item.CustomBuilder _ + | Item.ArgName _ + | Item.ActivePatternCase _ -> CompletionItemKind.Other let isUnresolved = match assemblySymbol with @@ -1115,19 +1147,23 @@ type internal TypeCheckInfo // Completion at 'inherit C(...)" | Some (CompletionContext.Inherit (InheritanceContext.Class, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> GetBaseClassCandidates) + |> FilterRelevantItemsBy getItem None (getItem >> IsInheritsCompletionCandidate) |> Option.map toCompletionItems // Completion at 'interface ..." | Some (CompletionContext.Inherit (InheritanceContext.Interface, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> GetInterfaceCandidates) + |> FilterRelevantItemsBy getItem None (getItem >> IsInterfaceCompletionCandidate) |> Option.map toCompletionItems // Completion at 'implement ..." | Some (CompletionContext.Inherit (InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> (fun t -> GetBaseClassCandidates t || GetInterfaceCandidates t)) + |> FilterRelevantItemsBy + getItem + None + (getItem + >> (fun t -> IsInheritsCompletionCandidate t || IsInterfaceCompletionCandidate t)) |> Option.map toCompletionItems // Completion at ' { XXX = ... } " @@ -1377,6 +1413,7 @@ type internal TypeCheckInfo /// Return 'false' if this is not a completion item valid in an interface file. let IsValidSignatureFileItem item = match item with + | Item.TypeVar _ | Item.Types _ | Item.ModuleOrNamespaces _ -> true | _ -> false @@ -1406,7 +1443,7 @@ type internal TypeCheckInfo /// Get the auto-complete items at a location member _.GetDeclarations(parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = - let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName + let isSigFile = SourceFileImpl.IsSignatureFile mainInputFileName DiagnosticsScope.Protect range0 @@ -1431,7 +1468,7 @@ type internal TypeCheckInfo | None -> DeclarationListInfo.Empty | Some (items, denv, ctx, m) -> let items = - if isInterfaceFile then + if isSigFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items @@ -1463,7 +1500,7 @@ type internal TypeCheckInfo /// Get the symbols for auto-complete items at a location member _.GetDeclarationListSymbols(parseResultsOpt, line, lineStr, partialName, getAllEntities) = - let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName + let isSigFile = SourceFileImpl.IsSignatureFile mainInputFileName DiagnosticsScope.Protect range0 @@ -1488,7 +1525,7 @@ type internal TypeCheckInfo | None -> List.Empty | Some (items, denv, _, m) -> let items = - if isInterfaceFile then + if isSigFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items @@ -1504,10 +1541,10 @@ type internal TypeCheckInfo |> List.sortBy (fun d -> let n = match d.Item with - | Item.Types (_, TType_app (tcref, _, _) :: _) -> 1 + tcref.TyparsNoRange.Length + | Item.Types (_, AbbrevOrAppTy tcref :: _) -> 1 + tcref.TyparsNoRange.Length // Put delegate ctors after types, sorted by #typars. RemoveDuplicateItems will remove FakeInterfaceCtor and DelegateCtor if an earlier type is also reported with this name - | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) - | Item.DelegateCtor (TType_app (tcref, _, _)) -> 1000 + tcref.TyparsNoRange.Length + | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> 1000 + tcref.TyparsNoRange.Length // Put type ctors after types, sorted by #typars. RemoveDuplicateItems will remove DefaultStructCtors if a type is also reported with this name | Item.CtorGroup (_, cinfo :: _) -> 1000 + 10 * cinfo.DeclaringTyconRef.TyparsNoRange.Length | _ -> 0 @@ -1523,11 +1560,11 @@ type internal TypeCheckInfo items |> List.groupBy (fun d -> match d.Item with - | Item.Types (_, TType_app (tcref, _, _) :: _) + | Item.Types (_, AbbrevOrAppTy tcref :: _) | Item.ExnCase tcref -> tcref.LogicalName | Item.UnqualifiedType (tcref :: _) - | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) - | Item.DelegateCtor (TType_app (tcref, _, _)) -> tcref.CompiledName + | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> tcref.CompiledName | Item.CtorGroup (_, cinfo :: _) -> cinfo.ApparentEnclosingTyconRef.CompiledName | _ -> d.Item.DisplayName) @@ -1713,22 +1750,21 @@ type internal TypeCheckInfo | [] -> None | [ item ] -> GetF1Keyword g item.Item | _ -> - // handle new Type() + // For "new Type()" it seems from the code below that multiple items are returned. + // It combine the information from these items preferring a constructor if present. let allTypes, constr, ty = - List.fold - (fun (allTypes, constr, ty) (item: CompletionItem) -> - match item.Item, constr, ty with - | Item.Types _ as t, _, None -> allTypes, constr, Some t - | Item.Types _, _, _ -> allTypes, constr, ty - | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty - | _ -> false, None, None) - (true, None, None) - items + ((true, None, None), items) + ||> List.fold (fun (allTypes, constr, ty) (item: CompletionItem) -> + match item.Item, constr, ty with + | Item.Types _ as t, _, None -> allTypes, constr, Some t + | Item.Types _, _, _ -> allTypes, constr, ty + | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty + | _ -> false, None, None) match allTypes, constr, ty with - | true, Some (Item.CtorGroup _ as item), _ -> GetF1Keyword g item - | true, _, Some ty -> GetF1Keyword g ty - | _ -> None) + | true, Some item, _ -> GetF1Keyword g item + | true, _, Some item -> GetF1Keyword g item + | _ -> GetF1Keyword g items.Head.Item) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetF1Keyword: '%s'" msg) None) @@ -1799,7 +1835,8 @@ type internal TypeCheckInfo | Some ([], _, _, _) -> None | Some (items, denv, _, m) -> let allItems = - items |> List.collect (fun item -> FlattenItems g m item.ItemWithInst) + items + |> List.collect (fun item -> SelectMethodGroupItems2 g m item.ItemWithInst) let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(cenv, item.Item), item) @@ -1841,6 +1878,8 @@ type internal TypeCheckInfo let methodTypeParams = ilinfo.FormalMethodTypars |> List.map (fun ty -> ty.Name) classTypeParams @ methodTypeParams |> Array.ofList + // Detect external references. Currently this only labels references to .NET assemblies as external - F# + // references from nuget packages are not labelled as external. let result = match item.Item with | Item.CtorGroup (_, ILMeth (_, ilinfo, _) :: _) -> @@ -1909,21 +1948,19 @@ type internal TypeCheckInfo Some(FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) | _ -> None - | Item.ImplicitOp (_, - { - contents = Some (TraitConstraintSln.FSMethSln (_, _vref, _)) - }) -> - //Item.Value(vref) - None - - | Item.Types (_, TType_app (tr, _, _) :: _) when tr.IsLocalRef && tr.IsTypeAbbrev -> None - - | Item.Types (_, [ AppTy g (tr, _) ]) when not tr.IsLocalRef -> - match tr.TypeReprInfo, tr.PublicPath with - | TILObjectRepr (TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> - let fullName = parts |> String.concat "." - Some(FindDeclResult.ExternalDecl(assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | Item.Types (_, ty :: _) -> + match stripTyparEqns ty with + | TType_app (tr, _, _) -> + if tr.IsLocalRef then + None + else + match tr.TypeReprInfo, tr.PublicPath with + | TILObjectRepr (TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> + let fullName = parts |> String.concat "." + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | _ -> None | _ -> None + | _ -> None match result with diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index c2ee71a022e..fe5afbfc4ab 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsInterfaceFile file = + let IsSignatureFile file = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) @@ -608,6 +608,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.LibraryOnlyILAssembly _ | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ + | SynExpr.Typar _ | SynExpr.Ident _ | SynExpr.ImplicitZero _ | SynExpr.Const _ diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 73caa8c5736..ef769874226 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -80,6 +80,9 @@ module ItemKeyTags = [] let itemProperty = "p$" + [] + let itemTrait = "T$" + [] let itemTypeVar = "y$" @@ -371,6 +374,13 @@ and [] ItemKeyStoreBuilder() = | Some info -> writeEntityRef info.DeclaringTyconRef | _ -> () + | Item.Trait (info) -> + writeString ItemKeyTags.itemTrait + writeString info.MemberLogicalName + info.SupportTypes |> List.iter (writeType false) + info.CompiledObjectAndArgumentTypes |> List.iter (writeType false) + info.CompiledReturnType |> Option.iter (writeType false) + | Item.TypeVar (_, typar) -> writeTypar true typar | Item.Types (_, [ ty ]) -> writeType true ty @@ -405,17 +415,27 @@ and [] ItemKeyStoreBuilder() = writeString ItemKeyTags.itemDelegateCtor writeType false ty - | Item.MethodGroup _ -> () - | Item.CtorGroup _ -> () + // We should consider writing ItemKey for each of these + | Item.ArgName _ -> () | Item.FakeInterfaceCtor _ -> () - | Item.Types _ -> () | Item.CustomOperation _ -> () | Item.CustomBuilder _ -> () - | Item.ModuleOrNamespaces _ -> () | Item.ImplicitOp _ -> () - | Item.ArgName _ -> () | Item.SetterArg _ -> () - | Item.UnqualifiedType _ -> () + + // Empty lists do not occur + | Item.Types (_, []) -> () + | Item.UnqualifiedType [] -> () + | Item.MethodGroup (_, [], _) -> () + | Item.CtorGroup (_, []) -> () + | Item.ModuleOrNamespaces [] -> () + + // Items are flattened so multiples are not expected + | Item.Types (_, _ :: _ :: _) -> () + | Item.UnqualifiedType (_ :: _ :: _) -> () + | Item.MethodGroup (_, (_ :: _ :: _), _) -> () + | Item.CtorGroup (_, (_ :: _ :: _)) -> () + | Item.ModuleOrNamespaces (_ :: _ :: _) -> () let postCount = b.Count diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index fc4f9d21b75..5da02e32094 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -70,6 +70,69 @@ module TcResolutionsExtensions = let (|CNR|) (cnr: CapturedNameResolution) = (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) + let isDisposableTy g amap (ty: TType) = + not (typeEquiv g ty g.system_IDisposable_ty) + && protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + + let isDiscard (str: string) = str.StartsWith("_") + + let isValRefDisposable g amap (vref: ValRef) = + not (isDiscard vref.DisplayName) + && + // For values, we actually do want to color things if they literally are IDisposables + protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) + + let isStructTyconRef g (tcref: TyconRef) = + let ty = generalizedTyconRef g tcref + let underlyingTy = stripTyEqnsAndMeasureEqns g ty + isStructTy g underlyingTy + + let isValRefMutable g (vref: ValRef) = + // Mutable values, ref cells, and non-inref byrefs are mutable. + vref.IsMutable + || isRefCellTy g vref.Type + || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) + + let isRecdFieldMutable g (rfinfo: RecdFieldInfo) = + (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) + || isRefCellTy g rfinfo.RecdField.FormalType + + let reprToClassificationType g repr tcref = + match repr with + | TFSharpObjectRepr om -> + match om.fsobjmodel_kind with + | TFSharpClass -> SemanticClassificationType.ReferenceType + | TFSharpInterface -> SemanticClassificationType.Interface + | TFSharpStruct -> SemanticClassificationType.ValueType + | TFSharpDelegate _ -> SemanticClassificationType.Delegate + | TFSharpEnum _ -> SemanticClassificationType.Enumeration + | TFSharpRecdRepr _ + | TFSharpUnionRepr _ -> + if isStructTyconRef g tcref then + SemanticClassificationType.ValueType + else + SemanticClassificationType.Type + | TILObjectRepr (TILObjectReprData (_, _, td)) -> + if td.IsClass then + SemanticClassificationType.ReferenceType + elif td.IsStruct then + SemanticClassificationType.ValueType + elif td.IsInterface then + SemanticClassificationType.Interface + elif td.IsEnum then + SemanticClassificationType.Enumeration + else + SemanticClassificationType.Delegate + | TAsmRepr _ -> SemanticClassificationType.TypeDef + | TMeasureableRepr _ -> SemanticClassificationType.TypeDef +#if !NO_TYPEPROVIDERS + | TProvidedTypeRepr _ -> SemanticClassificationType.TypeDef + | TProvidedNamespaceRepr _ -> SemanticClassificationType.TypeDef +#endif + | TNoRepr -> SemanticClassificationType.ReferenceType + type TcResolutions with member sResolutions.GetSemanticClassification @@ -138,35 +201,6 @@ module TcResolutionsExtensions = |> Array.concat | None -> sResolutions.CapturedNameResolutions.ToArray() - let isDisposableTy (ty: TType) = - not (typeEquiv g ty g.system_IDisposable_ty) - && protectAssemblyExplorationNoReraise false false (fun () -> - ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) - - let isDiscard (str: string) = str.StartsWith("_") - - let isValRefDisposable (vref: ValRef) = - not (isDiscard vref.DisplayName) - && - // For values, we actually do want to color things if they literally are IDisposables - protectAssemblyExplorationNoReraise false false (fun () -> - ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) - - let isStructTyconRef (tcref: TyconRef) = - let ty = generalizedTyconRef g tcref - let underlyingTy = stripTyEqnsAndMeasureEqns g ty - isStructTy g underlyingTy - - let isValRefMutable (vref: ValRef) = - // Mutable values, ref cells, and non-inref byrefs are mutable. - vref.IsMutable - || isRefCellTy g vref.Type - || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) - - let isRecdFieldMutable (rfinfo: RecdFieldInfo) = - (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) - || isRefCellTy g rfinfo.RecdField.FormalType - let duplicates = HashSet(comparer) let results = ImmutableArray.CreateBuilder() @@ -183,7 +217,7 @@ module TcResolutionsExtensions = ItemOccurence.Use, m -> add m SemanticClassificationType.ComputationExpression - | Item.Value vref, _, m when isValRefMutable vref -> add m SemanticClassificationType.MutableVar + | Item.Value vref, _, m when isValRefMutable g vref -> add m SemanticClassificationType.MutableVar | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, m -> add m SemanticClassificationType.IntrinsicFunction @@ -202,7 +236,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Function | Item.Value vref, _, m -> - if isValRefDisposable vref then + if isValRefDisposable g amap vref then if vref.IsCompiledAsTopLevel then add m SemanticClassificationType.DisposableTopLevelValue else @@ -218,7 +252,7 @@ module TcResolutionsExtensions = match rfinfo with | EnumCaseFieldInfo -> add m SemanticClassificationType.Enumeration | _ -> - if isRecdFieldMutable rfinfo then + if isRecdFieldMutable g rfinfo then add m SemanticClassificationType.MutableRecordField elif isFunTy g rfinfo.FieldType then add m SemanticClassificationType.RecordFieldAsFunction @@ -244,7 +278,10 @@ module TcResolutionsExtensions = match minfos with | [] -> add m SemanticClassificationType.ConstructorForReferenceType | _ -> - if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then + if + minfos + |> List.forall (fun minfo -> isDisposableTy g amap minfo.ApparentEnclosingType) + then add m SemanticClassificationType.DisposableType elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then add m SemanticClassificationType.ConstructorForValueType @@ -269,52 +306,18 @@ module TcResolutionsExtensions = // Special case measures for struct types | Item.Types (_, AppTy g (tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, m when - isStructTyconRef tyconRef + isStructTyconRef g tyconRef -> add m SemanticClassificationType.ValueType | Item.Types (_, ty :: _), LegitTypeOccurence, m -> - let reprToClassificationType repr tcref = - match repr with - | TFSharpObjectRepr om -> - match om.fsobjmodel_kind with - | TFSharpClass -> SemanticClassificationType.ReferenceType - | TFSharpInterface -> SemanticClassificationType.Interface - | TFSharpStruct -> SemanticClassificationType.ValueType - | TFSharpDelegate _ -> SemanticClassificationType.Delegate - | TFSharpEnum _ -> SemanticClassificationType.Enumeration - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ -> - if isStructTyconRef tcref then - SemanticClassificationType.ValueType - else - SemanticClassificationType.Type - | TILObjectRepr (TILObjectReprData (_, _, td)) -> - if td.IsClass then - SemanticClassificationType.ReferenceType - elif td.IsStruct then - SemanticClassificationType.ValueType - elif td.IsInterface then - SemanticClassificationType.Interface - elif td.IsEnum then - SemanticClassificationType.Enumeration - else - SemanticClassificationType.Delegate - | TAsmRepr _ -> SemanticClassificationType.TypeDef - | TMeasureableRepr _ -> SemanticClassificationType.TypeDef -#if !NO_TYPEPROVIDERS - | TProvidedTypeRepr _ -> SemanticClassificationType.TypeDef - | TProvidedNamespaceRepr _ -> SemanticClassificationType.TypeDef -#endif - | TNoRepr -> SemanticClassificationType.ReferenceType - let ty = stripTyEqns g ty - if isDisposableTy ty then + if isDisposableTy g amap ty then add m SemanticClassificationType.DisposableType else match tryTcrefOfAppTy g ty with - | ValueSome tcref -> add m (reprToClassificationType tcref.TypeReprInfo tcref) + | ValueSome tcref -> add m (reprToClassificationType g tcref.TypeReprInfo tcref) | ValueNone -> if isStructTupleTy g ty then add m SemanticClassificationType.ValueType @@ -341,6 +344,8 @@ module TcResolutionsExtensions = | Item.UnionCase _, _, m -> add m SemanticClassificationType.UnionCase + | Item.Trait _, _, m -> add m SemanticClassificationType.Method + | Item.ActivePatternResult _, _, m -> add m SemanticClassificationType.UnionCase | Item.UnionCaseField _, _, m -> add m SemanticClassificationType.UnionCaseField @@ -371,7 +376,7 @@ module TcResolutionsExtensions = elif tcref.IsNamespace then add m SemanticClassificationType.Namespace elif tcref.IsUnionTycon || tcref.IsRecordTycon then - if isStructTyconRef tcref then + if isStructTyconRef g tcref then add m SemanticClassificationType.ValueType else add m SemanticClassificationType.UnionCase diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 9491e8fa07a..17f8b27213d 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, _)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> // operator with solution FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv { item with Item = Item.Value vref } @@ -384,6 +384,12 @@ module DeclarationListHelpers = let layout = NicePrint.prettyLayoutOfTypar denv typar ToolTipElement.Single (toArray layout, xml) + // Traits + | Item.Trait traitInfo -> + let denv = { denv with shortConstraints = false} + let layout = NicePrint.prettyLayoutOfTrait denv traitInfo + ToolTipElement.Single (toArray layout, xml) + // F# Modules and namespaces | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> //let os = StringBuilder() @@ -453,8 +459,44 @@ module DeclarationListHelpers = | Item.SetterArg (_, item) -> FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv (ItemWithNoInst item) - | _ -> - ToolTipElement.None + | Item.ArgName (None, _, _, _) + + // TODO: give a decent tooltip for implicit operators that include the resolution of the operator + // + //type C() = + // static member (++++++) (x: C, y: C) = C() + // + //let f (x: C) = + // x ++++++ x + // + // Here hovering over "++++++" in "f" could give a tooltip saying what the thing is and what it has resolved to. + // + // + | Item.ImplicitOp _ + + // TODO: consider why we aren't getting Item.Types for generic type parameters + // let F<'T>() = new System.Collections.Generic.List<'T>() + | Item.Types (_, [TType_var _]) + + // TODO: consider why we aren't getting Item.Types for units of measure + | Item.Types (_, [TType_measure _]) + + // TODO: consider whether we ever get Item.Types with more than one element + | Item.Types (_, _ :: _ :: _) + + // We don't expect Item.Types with an anonymous record type, function types etc. + | Item.Types (_, [TType_anon _]) + | Item.Types (_, [TType_fun _]) + | Item.Types (_, [TType_forall _]) + | Item.Types (_, [TType_tuple _]) + | Item.Types (_, [TType_ucase _]) + + // We don't expect these cases + | Item.Types (_, []) + | Item.Property (_, []) + | Item.UnqualifiedType [] + | Item.ModuleOrNamespaces [] + | Item.CustomOperation (_, _, None) -> ToolTipElement.None /// Format the structured version of a tooltip for an item let FormatStructuredDescriptionOfItem isDecl infoReader ad m denv item = @@ -747,6 +789,14 @@ module internal DescriptionListsImpl = // for display as part of the method group prettyParams, prettyRetTyL + | Item.Trait traitInfo -> + let paramDatas = + [ for pty in traitInfo.GetLogicalArgumentTypes(g) do + ParamData(false, false, false, OptionalArgInfo.NotOptional, CallerInfo.NoCallerInfo, None, ReflectedArgInfo.None, pty) ] + let retTy = traitInfo.GetReturnType(g) + let _prettyTyparInst, prettyParams, prettyRetTyL, _prettyConstraintsL = PrettyParamsOfParamDatas g denv item.TyparInstantiation paramDatas retTy + prettyParams, prettyRetTyL + | Item.CustomBuilder (_, vref) -> PrettyParamsAndReturnTypeOfItem infoReader m denv { item with Item = Item.Value vref } @@ -785,7 +835,19 @@ module internal DescriptionListsImpl = // for display as part of the method group prettyParams, prettyRetTyL - | _ -> + | Item.CustomOperation _ // TODO: consider whether this should report parameter help + | Item.ActivePatternResult _ // TODO: consider whether this should report parameter help + | Item.UnqualifiedType _ + | Item.UnionCaseField _ + | Item.Types _ + | Item.SetterArg _ + | Item.NewDef _ + | Item.ModuleOrNamespaces _ + | Item.ImplicitOp _ + | Item.ArgName _ + | Item.MethodGroup(_, [], _) + | Item.CtorGroup(_,[]) + | Item.Property(_,[]) -> [], emptyL @@ -839,7 +901,9 @@ module internal DescriptionListsImpl = else FSharpGlyph.Variable | Item.Types(_, ty :: _) -> typeToGlyph (stripTyEqns denv.g ty) | Item.UnionCase _ - | Item.ActivePatternCase _ -> FSharpGlyph.EnumMember + | Item.ActivePatternResult _ + | Item.ImplicitOp _ + | Item.ActivePatternCase _ -> FSharpGlyph.EnumMember | Item.ExnCase _ -> FSharpGlyph.Exception | Item.AnonRecdField _ -> FSharpGlyph.Field | Item.RecdField _ -> FSharpGlyph.Field @@ -853,6 +917,7 @@ module internal DescriptionListsImpl = | Item.CustomOperation _ -> FSharpGlyph.Method | Item.MethodGroup (_, minfos, _) when minfos |> List.forall (fun minfo -> minfo.IsExtensionMember) -> FSharpGlyph.ExtensionMethod | Item.MethodGroup _ -> FSharpGlyph.Method + | Item.Trait _ -> FSharpGlyph.Method | Item.TypeVar _ -> FSharpGlyph.TypeParameter | Item.Types _ -> FSharpGlyph.Class | Item.UnqualifiedType (tcref :: _) -> @@ -874,17 +939,23 @@ module internal DescriptionListsImpl = else FSharpGlyph.Class | Item.ModuleOrNamespaces(modref :: _) -> if modref.IsNamespace then FSharpGlyph.NameSpace else FSharpGlyph.Module - | Item.ArgName _ -> FSharpGlyph.Variable + | Item.NewDef _ + | Item.ArgName _ | Item.SetterArg _ -> FSharpGlyph.Variable - | _ -> FSharpGlyph.Error) + + // These empty lists are not expected to occur + | Item.ModuleOrNamespaces [] + | Item.UnqualifiedType [] -> + FSharpGlyph.Error + ) - /// Get rid of groups of overloads an replace them with single items. - /// (This looks like it is doing the a similar thing as FlattenItems, this code - /// duplication could potentially be removed) - let AnotherFlattenItems g m item = + /// Select the items that participate in a MethodGroup. + let SelectMethodGroupItems g m item = match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos + | Item.Trait traitInfo -> + if traitInfo.GetLogicalArgumentTypes(g).IsEmpty then [] else [item] | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ -> [item] | Item.NewDef _ @@ -907,11 +978,20 @@ module internal DescriptionListsImpl = [item] #endif | Item.MethodGroup(nm, minfos, orig) -> minfos |> List.map (fun minfo -> Item.MethodGroup(nm, [minfo], orig)) - | Item.CustomOperation(_name, _helpText, _minfo) -> [item] - | Item.TypeVar _ -> [] - | Item.CustomBuilder _ -> [] - | _ -> [] - + | Item.CustomOperation _ -> [item] + // These are not items that can participate in a method group + | Item.TypeVar _ + | Item.CustomBuilder _ + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.SetterArg _ + | Item.Types _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.ActivePatternResult _ -> [] /// An intellisense declaration [] @@ -1181,7 +1261,7 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = | true, res -> yield! res | false, _ -> #endif - let flatItems = AnotherFlattenItems g m item.Item + let flatItems = SelectMethodGroupItems g m item.Item let methods = flatItems |> Array.ofList |> Array.map (fun flatItem -> @@ -1228,4 +1308,3 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = MethodGroup(name, methods) static member internal Empty = empty - diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 6e4812eeb6d..9a1a53ac658 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -649,6 +649,8 @@ module SyntaxTraversal = | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None + | SynExpr.Typar (_typar, _range) -> None + | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 662a420ae0b..d41cef4a04b 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsInterfaceFile file = + let IsSignatureFile file = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) @@ -611,6 +611,7 @@ module ParsedInput = List.tryPick walkType ts |> Option.orElseWith (fun () -> walkMemberSig sign) | SynTypeConstraint.WhereTyparIsEnum (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) | SynTypeConstraint.WhereTyparIsDelegate (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) + | SynTypeConstraint.WhereSelfConstrained (ts, _) -> walkType ts and walkPatWithKind (kind: EntityKind option) pat = match pat with @@ -830,7 +831,7 @@ module ParsedInput = | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> - List.tryPick walkTypar ts + List.tryPick walkType ts |> Option.orElseWith (fun () -> walkMemberSig sign) |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) @@ -1615,6 +1616,7 @@ module ParsedInput = | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> List.iter walkType ts walkMemberSig sign + | SynTypeConstraint.WhereSelfConstrained (ty, _) -> walkType ty and walkPat pat = match pat with @@ -1802,7 +1804,7 @@ module ParsedInput = walkExpr e2 | SynExpr.TraitCall (ts, sign, e, _) -> - List.iter walkTypar ts + List.iter walkType ts walkMemberSig sign walkExpr e | SynExpr.Const (SynConst.Measure (_, _, m), _) -> walkMeasure m diff --git a/src/Compiler/Service/ServiceParsedInputOps.fsi b/src/Compiler/Service/ServiceParsedInputOps.fsi index 07a1ac56fe6..d1f78613db7 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fsi +++ b/src/Compiler/Service/ServiceParsedInputOps.fsi @@ -157,6 +157,6 @@ module public ParsedInput = // implementation details used by other code in the compiler module internal SourceFileImpl = - val IsInterfaceFile: string -> bool + val IsSignatureFile: string -> bool val GetImplicitConditionalDefinesForEditing: isInteractive: bool -> string list diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 3320dd4ec73..eabc11f3410 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -307,22 +307,18 @@ module FSharpExprConvert = let (|TTypeConvOp|_|) (cenv: SymbolEnv) ty = let g = cenv.g match ty with - | TType_app (tcref, _, _) -> - match tcref with - | _ when tyconRefEq g tcref g.sbyte_tcr -> Some mkCallToSByteOperator - | _ when tyconRefEq g tcref g.byte_tcr -> Some mkCallToByteOperator - | _ when tyconRefEq g tcref g.int16_tcr -> Some mkCallToInt16Operator - | _ when tyconRefEq g tcref g.uint16_tcr -> Some mkCallToUInt16Operator - | _ when tyconRefEq g tcref g.int_tcr -> Some mkCallToIntOperator - | _ when tyconRefEq g tcref g.int32_tcr -> Some mkCallToInt32Operator - | _ when tyconRefEq g tcref g.uint32_tcr -> Some mkCallToUInt32Operator - | _ when tyconRefEq g tcref g.int64_tcr -> Some mkCallToInt64Operator - | _ when tyconRefEq g tcref g.uint64_tcr -> Some mkCallToUInt64Operator - | _ when tyconRefEq g tcref g.float32_tcr -> Some mkCallToSingleOperator - | _ when tyconRefEq g tcref g.float_tcr -> Some mkCallToDoubleOperator - | _ when tyconRefEq g tcref g.nativeint_tcr -> Some mkCallToIntPtrOperator - | _ when tyconRefEq g tcref g.unativeint_tcr -> Some mkCallToUIntPtrOperator - | _ -> None + | _ when typeEquiv g ty g.sbyte_ty -> Some mkCallToSByteOperator + | _ when typeEquiv g ty g.byte_ty -> Some mkCallToByteOperator + | _ when typeEquiv g ty g.int16_ty -> Some mkCallToInt16Operator + | _ when typeEquiv g ty g.uint16_ty -> Some mkCallToUInt16Operator + | _ when typeEquiv g ty g.int32_ty -> Some mkCallToInt32Operator + | _ when typeEquiv g ty g.uint32_ty -> Some mkCallToUInt32Operator + | _ when typeEquiv g ty g.int64_ty -> Some mkCallToInt64Operator + | _ when typeEquiv g ty g.uint64_ty -> Some mkCallToUInt64Operator + | _ when typeEquiv g ty g.float32_ty -> Some mkCallToSingleOperator + | _ when typeEquiv g ty g.float_ty -> Some mkCallToDoubleOperator + | _ when typeEquiv g ty g.nativeint_ty -> Some mkCallToIntPtrOperator + | _ when typeEquiv g ty g.unativeint_ty -> Some mkCallToUIntPtrOperator | _ -> None let ConvType cenv ty = FSharpType(cenv, ty) @@ -793,10 +789,10 @@ module FSharpExprConvert = let op2 = convertOp2 g m ty2 op1 ConvExprPrim cenv env op2 - | TOp.ILAsm ([ ILConvertOp convertOp ], [TType_app (tcref, _, _)]), _, [arg] -> + | TOp.ILAsm ([ ILConvertOp convertOp ], [ty2]), _, [arg] -> let ty = tyOfExpr g arg let op = - if tyconRefEq g tcref g.char_tcr then + if typeEquiv g ty2 g.char_ty then mkCallToCharOperator g m ty arg else convertOp g m ty arg ConvExprPrim cenv env op @@ -917,7 +913,7 @@ module FSharpExprConvert = | _ -> wfail (sprintf "unhandled construct in AST", m) | Expr.WitnessArg (traitInfo, _m) -> - ConvWitnessInfoPrim cenv env traitInfo + ConvWitnessInfoPrim env traitInfo | Expr.DebugPoint (_, innerExpr) -> ConvExprPrim cenv env innerExpr @@ -925,8 +921,8 @@ module FSharpExprConvert = | _ -> wfail (sprintf "unhandled construct in AST", expr.Range) - and ConvWitnessInfoPrim _cenv env traitInfo : E = - let witnessInfo = traitInfo.TraitKey + and ConvWitnessInfoPrim env traitInfo : E = + let witnessInfo = traitInfo.GetWitnessInfo() let env = { env with suppressWitnesses = true } // First check if this is a witness in ReflectedDefinition code if env.witnessesInScope.ContainsKey witnessInfo then @@ -939,9 +935,9 @@ module FSharpExprConvert = and ConvWitnessInfo cenv env m traitInfo : FSharpExpr = let g = cenv.g - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let witnessTy = GenWitnessTy g witnessInfo - let traitInfoR = ConvWitnessInfoPrim cenv env traitInfo + let traitInfoR = ConvWitnessInfoPrim env traitInfo Mk cenv m witnessTy traitInfoR and ConvLetBind cenv env (bind : Binding) = diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index f385e3575e1..a3232c3db39 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -102,6 +102,7 @@ module internal SymbolHelpers = | Item.Property(_, pinfos) -> rangeOfPropInfo preferFlag pinfos.Head | Item.Types(_, tys) -> tys |> List.tryPick (tryNiceEntityRefOfTyOption >> Option.map (rangeOfEntityRef preferFlag)) | Item.CustomOperation (_, _, Some minfo) -> rangeOfMethInfo g preferFlag minfo + | Item.Trait _ -> None | Item.TypeVar (_, tp) -> Some tp.Range | Item.ModuleOrNamespaces modrefs -> modrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.MethodGroup(_, minfos, _) @@ -110,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, _))}) -> Some vref.Range + | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(vref=vref))}) -> Some vref.Range | Item.ImplicitOp _ -> None | Item.UnqualifiedType tcrefs -> tcrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.DelegateCtor ty @@ -167,21 +168,27 @@ module internal SymbolHelpers = |> Option.bind ccuOfValRef |> Option.orElseWith (fun () -> pinfo.DeclaringTyconRef |> computeCcuOfTyconRef)) - | Item.ArgName (_, _, Some (ArgumentContainer.Method minfo), _) -> - ccuOfMethInfo g minfo + | Item.ArgName (_, _, meth, _) -> + match meth with + | None -> None + | Some (ArgumentContainer.Method minfo) -> ccuOfMethInfo g minfo + | Some (ArgumentContainer.Type eref) -> computeCcuOfTyconRef eref | Item.MethodGroup(_, minfos, _) | Item.CtorGroup(_, minfos) -> minfos |> List.tryPick (ccuOfMethInfo g) - | Item.CustomOperation (_, _, Some minfo) -> - ccuOfMethInfo g minfo + | Item.CustomOperation (_, _, meth) -> + match meth with + | None -> None + | Some minfo -> ccuOfMethInfo g minfo | Item.Types(_, tys) -> tys |> List.tryPick (tryNiceEntityRefOfTyOption >> Option.bind computeCcuOfTyconRef) - | Item.ArgName (_, _, Some (ArgumentContainer.Type eref), _) -> - computeCcuOfTyconRef eref + | Item.FakeInterfaceCtor(ty) + | Item.DelegateCtor(ty) -> + ty |> tryNiceEntityRefOfTyOption |> Option.bind computeCcuOfTyconRef | Item.ModuleOrNamespaces erefs | Item.UnqualifiedType erefs -> @@ -193,8 +200,20 @@ module internal SymbolHelpers = | Item.AnonRecdField (info, _, _, _) -> Some info.Assembly + // This is not expected: you can't directly refer to trait constraints in other assemblies + | Item.Trait _ -> None + + // This is not expected: you can't directly refer to type variables in other assemblies | Item.TypeVar _ -> None - | _ -> None + + // This is not expected: you can't directly refer to active pattern result tags in other assemblies + | Item.ActivePatternResult _ -> None + + // This is not expected: implicit operator references only occur in the current assembly + | Item.ImplicitOp _ -> None + + // This is not expected: NewDef only occurs within checking + | Item.NewDef _ -> None /// Work out the source file for an item and fix it up relative to the CCU if it is relative. let fileNameOfItem (g: TcGlobals) qualProjectDir (m: range) h = @@ -246,7 +265,7 @@ module internal SymbolHelpers = |> Option.defaultValue xmlDoc /// This function gets the signature to pass to Visual Studio to use its lookup functions for .NET stuff. - let GetXmlDocHelpSigOfItemForLookup (infoReader: InfoReader) m d = + let rec GetXmlDocHelpSigOfItemForLookup (infoReader: InfoReader) m d = let g = infoReader.g match d with | Item.ActivePatternCase (APElemRef(_, vref, _, _)) @@ -256,6 +275,7 @@ module internal SymbolHelpers = | Item.UnionCase (ucinfo, _) -> mkXmlComment (GetXmlDocSigOfUnionCaseRef ucinfo.UnionCaseRef) + | Item.UnqualifiedType (tcref :: _) | Item.ExnCase tcref -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) @@ -267,12 +287,19 @@ module internal SymbolHelpers = | Item.ILField finfo -> mkXmlComment (GetXmlDocSigOfILFieldInfo infoReader m finfo) - | Item.Types(_, TType_app(tcref, _, _) :: _) -> - mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) + | Item.FakeInterfaceCtor ty + | Item.DelegateCtor ty + | Item.Types(_, ty :: _) -> + match ty with + | AbbrevOrAppTy tcref -> + mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) + | _ -> FSharpXmlDoc.None | Item.CustomOperation (_, _, Some minfo) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) + | Item.Trait _ -> FSharpXmlDoc.None + | Item.TypeVar _ -> FSharpXmlDoc.None | Item.ModuleOrNamespaces(modref :: _) -> @@ -290,7 +317,7 @@ module internal SymbolHelpers = | Item.CtorGroup(_, minfo :: _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) - | Item.ArgName(_, _, Some argContainer, _) -> + | Item.ArgName(_, _, Some argContainer, _) -> match argContainer with | ArgumentContainer.Method minfo -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) | ArgumentContainer.Type tcref -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) @@ -298,7 +325,24 @@ module internal SymbolHelpers = | Item.UnionCaseField (ucinfo, _) -> mkXmlComment (GetXmlDocSigOfUnionCaseRef ucinfo.UnionCaseRef) - | _ -> FSharpXmlDoc.None + | Item.SetterArg (_, item) -> + GetXmlDocHelpSigOfItemForLookup infoReader m item + + // These do not have entires in XML doc files + | Item.CustomOperation _ + | Item.ArgName _ + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ImplicitOp _ + + // These empty lists are not expected to occur + | Item.CtorGroup (_, []) + | Item.MethodGroup (_, [], _) + | Item.Property (_, []) + | Item.ModuleOrNamespaces [] + | Item.UnqualifiedType [] + | Item.Types(_, []) -> + FSharpXmlDoc.None |> GetXmlDocFromLoader infoReader @@ -335,8 +379,9 @@ module internal SymbolHelpers = { new IPartialEqualityComparer<_> with member x.InEqualityRelation item = match item with - | Item.Types(_, [_]) -> true - | Item.ILField(ILFieldInfo _) -> true + | Item.Trait _ -> true + | Item.Types(_, _ :: _) -> true + | Item.ILField(_) -> true | Item.RecdField _ -> true | Item.SetterArg _ -> true | Item.TypeVar _ -> true @@ -352,7 +397,21 @@ module internal SymbolHelpers = | Item.Property _ -> true | Item.CtorGroup _ -> true | Item.UnqualifiedType _ -> true - | _ -> false + + // These are never expected to have duplicates in declaration lists etc + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.FakeInterfaceCtor _ + | Item.ImplicitOp _ + | Item.NewDef _ + | Item.UnionCaseField _ + + // These are not expected to occur + | Item.Types(_, []) + | Item.ModuleOrNamespaces [] -> false + + //| _ -> false member x.Equals(item1, item2) = // This may explore assemblies that are not in the reference set. @@ -371,7 +430,7 @@ module internal SymbolHelpers = // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' match item1, item2 with | Item.DelegateCtor ty1, Item.DelegateCtor ty2 -> equalHeadTypes(ty1, ty2) - | Item.Types(dn1, [ty1]), Item.Types(dn2, [ty2]) -> + | Item.Types(dn1, ty1 :: _), Item.Types(dn2, ty2 :: _) -> // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both dn1 = dn2 && equalHeadTypes(ty1, ty2) @@ -379,8 +438,8 @@ module internal SymbolHelpers = | ItemWhereTypIsPreferred ty1, ItemWhereTypIsPreferred ty2 -> equalHeadTypes(ty1, ty2) | Item.ExnCase tcref1, Item.ExnCase tcref2 -> tyconRefEq g tcref1 tcref2 - | Item.ILField(ILFieldInfo(_, fld1)), Item.ILField(ILFieldInfo(_, fld2)) -> - fld1 === fld2 // reference equality on the object identity of the AbstractIL metadata blobs for the fields + | Item.ILField(fld1), Item.ILField(fld2) -> + ILFieldInfo.ILFieldInfosUseIdenticalDefinitions fld1 fld2 | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> @@ -404,14 +463,16 @@ module internal SymbolHelpers = EventInfo.EventInfosUseIdenticalDefinitions evt1 evt2 | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> anonInfoEquiv anon1 anon2 && i1 = i2 - | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + (traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName) + | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> (meths1, meths2) ||> List.forall2 (fun minfo1 minfo2 -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) | Item.UnqualifiedType tcrefs1, Item.UnqualifiedType tcrefs2 -> (tcrefs1, tcrefs2) ||> List.forall2 (fun tcref1 tcref2 -> tyconRefEq g tcref1 tcref2) - | Item.Types(_, [TType_app(tcref1, _, _)]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 - | Item.UnqualifiedType([tcref1]), Item.Types(_, [TType_app(tcref2, _, _)]) -> tyconRefEq g tcref1 tcref2 + | Item.Types(_, [AbbrevOrAppTy tcref1]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 + | Item.UnqualifiedType([tcref1]), Item.Types(_, [AbbrevOrAppTy tcref2]) -> tyconRefEq g tcref1 tcref2 | _ -> false) member x.GetHashCode item = @@ -423,8 +484,8 @@ module internal SymbolHelpers = match tryTcrefOfAppTy g ty with | ValueSome tcref -> hash tcref.LogicalName | _ -> 1010 - | Item.ILField(ILFieldInfo(_, fld)) -> - System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode fld // hash on the object identity of the AbstractIL metadata blob for the field + | Item.ILField(fld) -> + fld.ComputeHashCode() | Item.TypeVar (nm, _tp) -> hash nm | Item.CustomOperation (_, _, Some minfo) -> minfo.ComputeHashCode() | Item.CustomOperation (_, _, None) -> 1 @@ -438,10 +499,24 @@ module internal SymbolHelpers = | Item.UnionCase(UnionCaseInfo(_, UnionCaseRef(tcref, n)), _) -> hash(tcref.Stamp, n) | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, n))) -> hash(tcref.Stamp, n) | Item.AnonRecdField(anon, _, i, _) -> hash anon.SortedNames[i] + | Item.Trait traitInfo -> hash traitInfo.MemberLogicalName | Item.Event evt -> evt.ComputeHashCode() | Item.Property(_name, pis) -> hash (pis |> List.map (fun pi -> pi.ComputeHashCode())) | Item.UnqualifiedType(tcref :: _) -> hash tcref.LogicalName - | _ -> failwith "unreachable") } + + // These are not expected to occur, see InEqualityRelation and ItemWhereTypIsPreferred + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.FakeInterfaceCtor _ + | Item.ImplicitOp _ + | Item.NewDef _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Types _ + | Item.DelegateCtor _ + | Item.ModuleOrNamespaces [] -> 0 + ) } let ItemWithTypeDisplayPartialEquality g = let itemComparer = ItemDisplayPartialEquality g @@ -491,11 +566,11 @@ module internal SymbolHelpers = let rec FullNameOfItem g item = let denv = DisplayEnv.Empty g match item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> fullDisplayTextOfValRef vref | Item.UnionCase (ucinfo, _) -> fullDisplayTextOfUnionCaseRef ucinfo.UnionCaseRef | Item.ActivePatternResult(apinfo, _ty, idx, _) -> apinfo.DisplayNameByIdx idx - | Item.ActivePatternCase apref -> FullNameOfItem g (Item.Value apref.ActivePatternVal) + "." + apref.DisplayName + | Item.ActivePatternCase apref -> FullNameOfItem g (Item.Value apref.ActivePatternVal) + "." + apref.DisplayName | Item.ExnCase ecref -> fullDisplayTextOfExnRef ecref | Item.AnonRecdField(anon, _argTys, i, _) -> anon.DisplayNameByIdx i | Item.RecdField rfinfo -> fullDisplayTextOfRecdFieldRef rfinfo.RecdFieldRef @@ -514,7 +589,8 @@ module internal SymbolHelpers = match tryTcrefOfAppTy g ty with | ValueSome tcref -> buildString (fun os -> NicePrint.outputTyconRef denv os tcref) | _ -> "" - | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> + | Item.Trait traitInfo -> traitInfo.MemberLogicalName + | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if definiteNamespace then fullDisplayTextOfModRef modref else modref.DisplayName | Item.TypeVar _ @@ -530,28 +606,41 @@ module internal SymbolHelpers = | Item.ModuleOrNamespaces [] | Item.Property(_, []) -> "" - /// Output a the description of a language item + /// Output the description of a language item let rec GetXmlCommentForItem (infoReader: InfoReader) m item = let g = infoReader.g match item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> - GetXmlCommentForItem infoReader m (Item.Value vref) + | Item.ImplicitOp(_, sln) -> + match sln.Value with + | Some(TraitConstraintSln.FSMethSln(vref=vref)) -> + GetXmlCommentForItem infoReader m (Item.Value vref) + | Some (TraitConstraintSln.ILMethSln _) + | Some (TraitConstraintSln.FSRecdFieldSln _) + | Some (TraitConstraintSln.FSAnonRecdFieldSln _) + | Some (TraitConstraintSln.ClosedExprSln _) + | Some TraitConstraintSln.BuiltInSln + | None -> + GetXmlCommentForItemAux None infoReader m item | Item.Value vref | Item.CustomBuilder (_, vref) -> - GetXmlCommentForItemAux (if valRefInThisAssembly g.compilingFSharpCore vref || vref.XmlDoc.NonEmpty then Some vref.XmlDoc else None) infoReader m item + let doc = if valRefInThisAssembly g.compilingFSharpCore vref || vref.XmlDoc.NonEmpty then Some vref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.UnionCase(ucinfo, _) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None) infoReader m item + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.ActivePatternCase apref -> - GetXmlCommentForItemAux (Some apref.ActivePatternVal.XmlDoc) infoReader m item + let doc = Some apref.ActivePatternVal.XmlDoc + GetXmlCommentForItemAux doc infoReader m item | Item.ExnCase ecref -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ecref || ecref.XmlDoc.NonEmpty then Some ecref.XmlDoc else None) infoReader m item + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ecref || ecref.XmlDoc.NonEmpty then Some ecref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.RecdField rfinfo -> let tcref = rfinfo.TyconRef - let xmldoc = + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then if tcref.IsFSharpException then Some tcref.XmlDoc @@ -559,55 +648,89 @@ module internal SymbolHelpers = Some rfinfo.RecdField.XmlDoc else None - GetXmlCommentForItemAux xmldoc infoReader m item + GetXmlCommentForItemAux doc infoReader m item | Item.Event einfo -> - GetXmlCommentForItemAux (if einfo.HasDirectXmlComment || einfo.XmlDoc.NonEmpty then Some einfo.XmlDoc else None) infoReader m item + let doc = if einfo.HasDirectXmlComment || einfo.XmlDoc.NonEmpty then Some einfo.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.Property(_, pinfos) -> let pinfo = pinfos.Head - GetXmlCommentForItemAux (if pinfo.HasDirectXmlComment || pinfo.XmlDoc.NonEmpty then Some pinfo.XmlDoc else None) infoReader m item + let doc = if pinfo.HasDirectXmlComment || pinfo.XmlDoc.NonEmpty then Some pinfo.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.CustomOperation (_, _, Some minfo) | Item.CtorGroup(_, minfo :: _) | Item.MethodGroup(_, minfo :: _, _) -> GetXmlCommentForMethInfoItem infoReader m item minfo - | Item.Types(_, TType_app(tcref, _, _) :: _) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None) infoReader m item + | Item.Types(_, tys) -> + let doc = + match tys with + | AbbrevOrAppTy tcref :: _ -> + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then + Some tcref.XmlDoc + else + None + | _ -> None + GetXmlCommentForItemAux doc infoReader m item + + | Item.UnqualifiedType(tcrefs) -> + let doc = + match tcrefs with + | tcref :: _ -> + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then + Some tcref.XmlDoc + else + None + | _ -> None + GetXmlCommentForItemAux doc infoReader m item | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if not definiteNamespace then - GetXmlCommentForItemAux (if entityRefInThisAssembly g.compilingFSharpCore modref || modref.XmlDoc.NonEmpty then Some modref.XmlDoc else None) infoReader m item + let doc = if entityRefInThisAssembly g.compilingFSharpCore modref || modref.XmlDoc.NonEmpty then Some modref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item else GetXmlCommentForItemAux None infoReader m item - | Item.ArgName (_, _, argContainer, _) -> - let xmldoc = + | Item.ArgName (_, _, argContainer, _) -> + let doc = match argContainer with | Some(ArgumentContainer.Method minfo) -> if minfo.HasDirectXmlComment || minfo.XmlDoc.NonEmpty then Some minfo.XmlDoc else None | Some(ArgumentContainer.Type tcref) -> if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None | _ -> None - GetXmlCommentForItemAux xmldoc infoReader m item + GetXmlCommentForItemAux doc infoReader m item | Item.UnionCaseField (ucinfo, _) -> - let xmldoc = - if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None - GetXmlCommentForItemAux xmldoc infoReader m item + let doc = + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then + Some ucinfo.UnionCase.XmlDoc + else + None + GetXmlCommentForItemAux doc infoReader m item | Item.SetterArg (_, item) -> GetXmlCommentForItem infoReader m item // In all these cases, there is no direct XML documentation from F# comments - | Item.ActivePatternResult _ + | Item.MethodGroup (_, [], _) + | Item.CtorGroup (_, []) + | Item.ModuleOrNamespaces [] + | Item.Types (_, []) + | Item.CustomOperation (_, _, None) + | Item.UnqualifiedType [] + | Item.TypeVar _ + | Item.Trait _ + | Item.AnonRecdField _ + | Item.ActivePatternResult _ | Item.NewDef _ | Item.ILField _ | Item.FakeInterfaceCtor _ - | Item.DelegateCtor _ - | _ -> + | Item.DelegateCtor _ -> + //| _ -> GetXmlCommentForItemAux None infoReader m item |> GetXmlDocFromLoader infoReader @@ -828,14 +951,19 @@ module internal SymbolHelpers = | Item.CustomOperation (_, _, None) // "into" | Item.NewDef _ // "let x$yz = ..." - no keyword | Item.ArgName _ // no keyword on named parameters - | Item.UnionCaseField _ + | Item.Trait _ + | Item.UnionCaseField _ | Item.TypeVar _ | Item.ImplicitOp _ | Item.ActivePatternResult _ // "let (|Foo|Bar|) = .. Fo$o ..." - no keyword -> None - /// Get rid of groups of overloads an replace them with single items. - let FlattenItems g (m: range) (item: ItemWithInst) : ItemWithInst list = + /// Select the items that participate in a MethodGroup. + // + // NOTE: This is almost identical to SelectMethodGroupItems and + // should be merged, and indeed is only used on the TypeCheckInfo::GetMethodsAsSymbols path, which is unused by + // the VS integration. + let SelectMethodGroupItems2 g (m: range) (item: ItemWithInst) : ItemWithInst list = ignore m match item.Item with | Item.MethodGroup(nm, minfos, orig) -> @@ -858,7 +986,19 @@ module internal SymbolHelpers = | ItemIsWithStaticArguments m g _ -> [item] // we pretend that provided-types-with-static-args are method-like in order to get ParamInfo for them #endif | Item.CustomOperation(_name, _helpText, _minfo) -> [item] + | Item.Trait _ -> [item] | Item.TypeVar _ -> [] | Item.CustomBuilder _ -> [] - | _ -> [] - + // These are not items that can participate in a method group + | Item.TypeVar _ + | Item.CustomBuilder _ + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.SetterArg _ + | Item.Types _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.ActivePatternResult _ -> [] diff --git a/src/Compiler/Symbols/SymbolHelpers.fsi b/src/Compiler/Symbols/SymbolHelpers.fsi index e862ba3dee6..b25bf18d60f 100755 --- a/src/Compiler/Symbols/SymbolHelpers.fsi +++ b/src/Compiler/Symbols/SymbolHelpers.fsi @@ -56,7 +56,7 @@ module internal SymbolHelpers = val IsExplicitlySuppressed: TcGlobals -> Item -> bool - val FlattenItems: TcGlobals -> range -> ItemWithInst -> ItemWithInst list + val SelectMethodGroupItems2: TcGlobals -> range -> ItemWithInst -> ItemWithInst list #if !NO_TYPEPROVIDERS val (|ItemIsProvidedType|_|): TcGlobals -> Item -> TyconRef option diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index daf77871cc0..ec343ad2a8d 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -310,6 +310,9 @@ type FSharpSymbol(cenv: SymbolEnv, item: unit -> Item, access: FSharpSymbol -> C | Item.TypeVar (_, tp) -> FSharpGenericParameter(cenv, tp) :> _ + | Item.Trait traitInfo -> + FSharpGenericParameterMemberConstraint(cenv, traitInfo) :> _ + | Item.ActivePatternCase apref -> FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ @@ -319,7 +322,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, _)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ // TODO: the following don't currently return any interesting subtype @@ -1417,6 +1420,10 @@ type FSharpAbstractSignature(cenv, info: SlotSig) = member _.DeclaringType = FSharpType(cenv, info.DeclaringType) type FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = + inherit FSharpSymbol (cenv, + (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 diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi index e8a88b65804..024448bf170 100644 --- a/src/Compiler/Symbols/Symbols.fsi +++ b/src/Compiler/Symbols/Symbols.fsi @@ -638,6 +638,8 @@ type FSharpStaticParameter = [] type FSharpGenericParameterMemberConstraint = + inherit FSharpSymbol + /// Get the types that may be used to satisfy the constraint member MemberSources: IList diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 9b54f1c9976..88a743a6bf2 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -1023,7 +1023,11 @@ type LexFilterImpl ( let peekAdjacentTypars indentation (tokenTup: TokenTup) = let lookaheadTokenTup = peekNextTokenTup() match lookaheadTokenTup.Token with - | INFIX_COMPARE_OP " + | INFIX_COMPARE_OP "", false) + | LESS _ -> let tokenEndPos = tokenTup.LexbufState.EndPos if isAdjacent tokenTup lookaheadTokenTup then let mutable stack = [] @@ -1070,7 +1074,14 @@ type LexFilterImpl ( let dotTokenTup = peekNextTokenTup() stack <- (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: stack true - | LPAREN | LESS _ | LBRACK | LBRACK_LESS | INFIX_COMPARE_OP " + | LPAREN + | LESS _ + | LBRACK + | LBRACK_LESS + | INFIX_COMPARE_OP "", false) -> scanAhead (nParen+1) // These tokens CAN occur in non-parenthesized positions in the grammar of types or type parameter definitions @@ -1119,13 +1130,22 @@ type LexFilterImpl ( let res = scanAhead 0 // Put the tokens back on and smash them up if needed - stack |> List.iter (fun (tokenTup, smash) -> + for (tokenTup, smash) in stack do if smash then match tokenTup.Token with | INFIX_COMPARE_OP " delayToken (pool.UseShiftedLocation(tokenTup, INFIX_STAR_DIV_MOD_OP "/", 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) pool.Return tokenTup + | INFIX_COMPARE_OP "<^" -> + delayToken (pool.UseShiftedLocation(tokenTup, INFIX_AT_HAT_OP "^", 1, 0)) + delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) + pool.Return tokenTup + // NOTE: this is "<@" + | LQUOTE ("<@ @>", false) -> + delayToken (pool.UseShiftedLocation(tokenTup, INFIX_AT_HAT_OP "@", 1, 0)) + delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) + pool.Return tokenTup | GREATER_BAR_RBRACK -> delayToken (pool.UseShiftedLocation(tokenTup, BAR_RBRACK, 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, GREATER res, 0, -2)) @@ -1146,7 +1166,7 @@ type LexFilterImpl ( pool.Return tokenTup | _ -> delayToken tokenTup else - delayToken tokenTup) + delayToken tokenTup res else false diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index 4cb172651ad..0440d019fa2 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -812,6 +812,40 @@ let mkSynMemberDefnGetSet | _ -> [] | _ -> [] +// Input Text Precedence by Parser Adjustment +// +// ^T.Ident ^(T.Ident) (^T).Ident +// ^T.Ident[idx] ^(T.Ident[idx]) (^T).Ident[idx] +// ^T.Ident.[idx] ^(T.Ident.[idx]) (^T).Ident.[idx] +// ^T.Ident.Ident2 ^(T.Ident.Ident2) (^T).Ident.Ident2 +// ^T.Ident(args).Ident3 ^(T.Ident(args).Ident3) (^T).Ident(args).Ident3 +// ^T.(+)(args) ^(T.(+)(args)) (^T).(+)(args).Ident3 +let adjustHatPrefixToTyparLookup mFull rightExpr = + let rec take inp = + match inp with + | SynExpr.Ident (typarIdent) + | SynExpr.LongIdent (false, SynLongIdent ([ typarIdent ], _, _), None, _) -> + let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) + SynExpr.Typar(typar, mFull) + | SynExpr.LongIdent (false, SynLongIdent ((typarIdent :: items), (dotm :: dots), (_ :: itemTrivias)), None, _) -> + let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) + let lookup = SynLongIdent(items, dots, itemTrivias) + SynExpr.DotGet(SynExpr.Typar(typar, mFull), dotm, lookup, mFull) + | SynExpr.App (isAtomic, false, funcExpr, argExpr, m) -> + let funcExpr2 = take funcExpr + SynExpr.App(isAtomic, false, funcExpr2, argExpr, unionRanges funcExpr2.Range m) + | SynExpr.DotGet (leftExpr, dotm, lookup, m) -> + let leftExpr2 = take leftExpr + SynExpr.DotGet(leftExpr2, dotm, lookup, m) + | SynExpr.DotIndexedGet (leftExpr, indexArg, dotm, m) -> + let leftExpr2 = take leftExpr + SynExpr.DotIndexedGet(leftExpr2, indexArg, dotm, m) + | _ -> + reportParseErrorAt mFull (FSComp.SR.parsIncompleteTyparExpr2 ()) + arbExpr ("hatExpr1", mFull) + + take rightExpr + // The last element of elementTypes does not have a star or slash let mkSynTypeTuple (isStruct: bool) (elementTypes: SynTupleTypeSegment list) : SynType = let range = diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index e84c3759fbe..1b321cd9302 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -176,4 +176,7 @@ val mkSynMemberDefnGetSet: rangeStart: range -> SynMemberDefn list +/// Incorporate a '^' for an qualified access to a generic type parameter +val adjustHatPrefixToTyparLookup: mFull: range -> rightExpr: SynExpr -> SynExpr + val mkSynTypeTuple: isStruct: bool -> elementTypes: SynTupleTypeSegment list -> SynType diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 9926d7d61fa..8a0b853f63e 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -332,6 +332,8 @@ type SynTypeConstraint = | WhereTyparIsDelegate of typar: SynTypar * typeArgs: SynType list * range: range + | WhereSelfConstrained of selfConstraint: SynType * range: range + member x.Range = match x with | WhereTyparIsValueType (range = range) @@ -345,6 +347,7 @@ type SynTypeConstraint = | WhereTyparSupportsMember (range = range) | WhereTyparIsEnum (range = range) | WhereTyparIsDelegate (range = range) -> range + | WhereSelfConstrained (range = range) -> range [] type SynTyparDecls = @@ -595,6 +598,8 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia + | Typar of typar: SynTypar * range: range + | Ident of ident: Ident | LongIdent of isOptional: bool * longDotId: SynLongIdent * altNameRefCell: SynSimplePatAlternativeIdInfo ref option * range: range @@ -635,7 +640,7 @@ type SynExpr = | AddressOf of isByref: bool * expr: SynExpr * opRange: range * range: range - | TraitCall of supportTys: SynTypar list * traitSig: SynMemberSig * argExpr: SynExpr * range: range + | TraitCall of supportTys: SynType list * traitSig: SynMemberSig * argExpr: SynExpr * range: range | JoinIn of lhsExpr: SynExpr * lhsRange: range * rhsExpr: SynExpr * range: range @@ -769,6 +774,7 @@ type SynExpr = | SynExpr.InterpolatedString (range = m) | SynExpr.Dynamic (range = m) -> m | SynExpr.Ident id -> id.idRange + | SynExpr.Typar (range = m) -> m | SynExpr.DebugPoint (_, _, innerExpr) -> innerExpr.Range member e.RangeWithoutAnyExtraDot = @@ -1417,7 +1423,8 @@ type SynMemberDefn = ident: Ident * typeOpt: SynType option * propKind: SynMemberKind * - memberFlags: (SynMemberKind -> SynMemberFlags) * + memberFlags: SynMemberFlags * + memberFlagsForSet: SynMemberFlags * xmlDoc: PreXmlDoc * accessibility: SynAccess option * equalsRange: range * diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 874518d28ba..503a7b2faa7 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -413,6 +413,9 @@ type SynTypeConstraint = /// F# syntax is 'typar: delegate<'Args, unit> | WhereTyparIsDelegate of typar: SynTypar * typeArgs: SynType list * range: range + /// F# syntax is SomeThing<'T> + | WhereSelfConstrained of selfConstraint: SynType * range: range + member Range: range /// List of type parameter declarations with optional type constraints, @@ -617,7 +620,7 @@ type SynExpr = range2: range * range: range - /// F# syntax: ^expr + /// F# syntax: ^expr, used for from-end-of-collection indexing and ^T.Operation | IndexFromEnd of expr: SynExpr * range: range /// F# syntax: { expr } @@ -731,6 +734,9 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia + /// F# syntax: 'T (for 'T.ident). + | Typar of typar: SynTypar * range: range + /// F# syntax: ident /// Optimized representation for SynExpr.LongIdent (false, [id], id.idRange) | Ident of ident: Ident @@ -802,8 +808,8 @@ type SynExpr = /// F# syntax: &expr, &&expr | AddressOf of isByref: bool * expr: SynExpr * opRange: range * range: range - /// F# syntax: ((typar1 or ... or typarN): (member-dig) expr) - | TraitCall of supportTys: SynTypar list * traitSig: SynMemberSig * argExpr: SynExpr * range: range + /// F# syntax: ((type1 or ... or typeN): (member-dig) expr) + | TraitCall of supportTys: SynType list * traitSig: SynMemberSig * argExpr: SynExpr * range: range /// F# syntax: ... in ... /// Computation expressions only, based on JOIN_IN token from lex filter @@ -1599,7 +1605,8 @@ type SynMemberDefn = ident: Ident * typeOpt: SynType option * propKind: SynMemberKind * - memberFlags: (SynMemberKind -> SynMemberFlags) * + memberFlags: SynMemberFlags * + memberFlagsForSet: SynMemberFlags * xmlDoc: PreXmlDoc * accessibility: SynAccess option * equalsRange: range * diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index b620ab7985f..590f5523214 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -734,10 +734,10 @@ let OverrideMemberFlags trivia k : SynMemberFlags = Trivia = trivia } -let AbstractMemberFlags trivia k : SynMemberFlags = +let AbstractMemberFlags isInstance trivia k : SynMemberFlags = { MemberKind = k - IsInstance = true + IsInstance = isInstance IsDispatchSlot = true IsOverrideOrExplicitImpl = false IsFinal = false @@ -756,6 +756,17 @@ let StaticMemberFlags trivia k : SynMemberFlags = Trivia = trivia } +let ImplementStaticMemberFlags trivia k : SynMemberFlags = + { + MemberKind = k + IsInstance = false + IsDispatchSlot = false + IsOverrideOrExplicitImpl = true + IsFinal = false + GetterOrSetterIsCompilerGenerated = false + Trivia = trivia + } + let MemberSynMemberFlagsTrivia (mMember: range) : SynMemberFlagsTrivia = { MemberRange = Some mMember @@ -810,6 +821,24 @@ let AbstractMemberSynMemberFlagsTrivia (mAbstract: range) (mMember: range) : Syn DefaultRange = None } +let StaticAbstractSynMemberFlagsTrivia mStatic mAbstract = + { + MemberRange = None + OverrideRange = None + AbstractRange = Some mAbstract + StaticRange = Some mStatic + DefaultRange = None + } + +let StaticAbstractMemberSynMemberFlagsTrivia mStatic mAbstract mMember = + { + MemberRange = Some mMember + OverrideRange = None + AbstractRange = Some mAbstract + StaticRange = Some mStatic + DefaultRange = None + } + let inferredTyparDecls = SynValTyparDecls(None, true) let noInferredTypars = SynValTyparDecls(None, false) @@ -850,6 +879,7 @@ let rec synExprContainsError inpExpr = | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ | SynExpr.Ident _ + | SynExpr.Typar _ | SynExpr.ImplicitZero _ | SynExpr.Const _ | SynExpr.Dynamic _ -> false diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 7af4403fac2..cafafaa0ec3 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -296,10 +296,12 @@ val ClassCtorMemberFlags: trivia: SynMemberFlagsTrivia -> SynMemberFlags val OverrideMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags -val AbstractMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags +val AbstractMemberFlags: isInstance: bool -> trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags val StaticMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags +val ImplementStaticMemberFlags: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags + val MemberSynMemberFlagsTrivia: mMember: range -> SynMemberFlagsTrivia val OverrideSynMemberFlagsTrivia: mOverride: range -> SynMemberFlagsTrivia @@ -312,6 +314,11 @@ val AbstractSynMemberFlagsTrivia: mAbstract: range -> SynMemberFlagsTrivia val AbstractMemberSynMemberFlagsTrivia: mAbstract: range -> mMember: range -> SynMemberFlagsTrivia +val StaticAbstractSynMemberFlagsTrivia: mStatic: range -> mAbstract: range -> SynMemberFlagsTrivia + +val StaticAbstractMemberSynMemberFlagsTrivia: + mStatic: range -> mAbstract: range -> mMember: range -> SynMemberFlagsTrivia + val inferredTyparDecls: SynValTyparDecls val noInferredTypars: SynValTyparDecls diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 7b42df06495..a38d87199e0 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1773,15 +1773,16 @@ type TcGlobals( /// AdditionDynamic for op_Addition. Also work out the type instantiation of the dynamic function. member _.MakeBuiltInWitnessInfo (t: TraitConstraintInfo) = let memberName = - let nm = t.MemberName + let nm = t.MemberLogicalName let coreName = if nm.StartsWith "op_" then nm[3..] elif nm = "get_Zero" then "GenericZero" elif nm = "get_One" then "GenericOne" else nm coreName + "Dynamic" + let gtps, argTys, retTy, tinst = - match memberName, t.ArgumentTypes, t.ReturnType with + match memberName, t.CompiledObjectAndArgumentTypes, t.CompiledReturnType with | ("AdditionDynamic" | "MultiplyDynamic" | "SubtractionDynamic"| "DivisionDynamic" | "ModulusDynamic" | "CheckedAdditionDynamic" | "CheckedMultiplyDynamic" | "CheckedSubtractionDynamic" | "LeftShiftDynamic" | "RightShiftDynamic" | "BitwiseAndDynamic" | "BitwiseOrDynamic" | "ExclusiveOrDynamic" | "LessThanDynamic" | "GreaterThanDynamic" | "LessThanOrEqualDynamic" | "GreaterThanOrEqualDynamic" | "EqualityDynamic" | "InequalityDynamic"), [ arg0Ty; arg1Ty ], Some retTy -> @@ -1795,13 +1796,14 @@ type TcGlobals( | ("GenericZeroDynamic" | "GenericOneDynamic"), [], Some retTy -> [vara], [ ], varaTy, [ retTy ] | _ -> failwithf "unknown builtin witness '%s'" memberName + let vref = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, memberName, None, None, gtps, (List.map List.singleton argTys, retTy)) vref, tinst /// Find an FSharp.Core operator that corresponds to a trait witness member g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy (t: TraitConstraintInfo) argExprs = - match t.MemberName, t.ArgumentTypes, t.ReturnType, argExprs with + match t.MemberLogicalName, t.CompiledObjectAndArgumentTypes, t.CompiledReturnType, argExprs with | "get_Sign", [aty], _, objExpr :: _ -> // Call Operators.sign let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sign", None, Some "Sign", [vara], ([[varaTy]], v_int32_ty)) @@ -1834,7 +1836,7 @@ type TcGlobals( Some (info, tyargs, []) | ("Abs" | "Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10"| "Log"), [aty], _, [_] -> // Call corresponding Operators.* - let nm = t.MemberName + let nm = t.MemberLogicalName let lower = if nm = "Ceiling" then "ceil" else nm.ToLowerInvariant() let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, lower, None, Some nm, [vara], ([[varaTy]], varaTy)) let tyargs = [aty] diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 47c343babd7..39d09093916 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -300,8 +300,8 @@ type TyparFlags(flags: int32) = TyparFlags((if isFromError then 0b00000000000000010 else 0) ||| (if isCompGen then 0b00000000000000100 else 0) ||| (match staticReq with - | TyparStaticReq.None -> 0b00000000000000000 - | TyparStaticReq.HeadType -> 0b00000000000001000) ||| + | TyparStaticReq.None -> 0b00000000000000000 + | TyparStaticReq.HeadType -> 0b00000000000001000) ||| (match rigidity with | TyparRigidity.Rigid -> 0b00000000000000000 | TyparRigidity.WillBeRigid -> 0b00000000000100000 @@ -376,6 +376,9 @@ type TyparFlags(flags: int32) = else TyparFlags(flags &&& ~~~0b00010000000000000) + member x.WithStaticReq staticReq = + TyparFlags(x.Kind, x.Rigidity, x.IsFromError, x.IsCompilerGenerated, staticReq, x.DynamicReq, x.EqualityConditionalOn, x.ComparisonConditionalOn) + /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion member x.PickledBits = flags @@ -2266,22 +2269,33 @@ type Typar = member x.SetIdent id = x.typar_id <- id /// Sets the rigidity of a type variable - member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetRigidity b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is compiler generated - member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetCompilerGenerated b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable has a static requirement - member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetStaticReq b = + x.typar_flags <- x.typar_flags.WithStaticReq(b) /// Sets whether a type variable is required at runtime - member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetDynamicReq b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether the equality constraint of a type definition depends on this type variable - member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) + member x.SetEqualityDependsOn b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) /// Sets whether the comparison constraint of a type definition depends on this type variable - member x.SetComparisonDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) + member x.SetComparisonDependsOn b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) [] member x.DebugText = x.ToString() @@ -2341,7 +2355,7 @@ type TyparConstraint = [] type TraitWitnessInfo = - | TraitWitnessInfo of TTypes * string * SynMemberFlags * TTypes * TType option + | TraitWitnessInfo of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTy: TType option /// Get the member name associated with the member constraint. member x.MemberName = (let (TraitWitnessInfo(_, b, _, _, _)) = x in b) @@ -2352,7 +2366,7 @@ type TraitWitnessInfo = [] member x.DebugText = x.ToString() - override x.ToString() = "TTrait(" + x.MemberName + ")" + override x.ToString() = "TraitWitnessInfo(" + x.MemberName + ")" /// The specification of a member constraint that must be solved [] @@ -2360,23 +2374,23 @@ 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 * _memFlags: SynMemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref + | TTrait of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * solution: TraitConstraintSln option ref - /// 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 types that may provide solutions for the traits + member x.SupportTypes = (let (TTrait(tys, _, _, _, _, _)) = x in tys) - /// Get the member name associated with the member constraint. - member x.MemberName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) + /// Get the logical member name associated with the member constraint. + 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) - /// Get the argument types recorded in the member constraint. This includes the object instance type for - /// instance members. - member x.ArgumentTypes = (let (TTrait(_, _, _, argTys, _, _)) = x in argTys) + member x.CompiledObjectAndArgumentTypes = (let (TTrait(_, _, _, objAndArgTys, _, _)) = x in objAndArgTys) - /// Get the return type recorded in the member constraint. - member x.ReturnType = (let (TTrait(_, _, _, _, ty, _)) = x in ty) + member x.WithMemberKind(kind) = (let (TTrait(a, b, c, d, e, f)) = x in TTrait(a, b, { c with MemberKind=kind }, d, e, f)) + + /// Get the optional return type recorded in the member constraint. + member x.CompiledReturnType = (let (TTrait(_, _, _, _, retTy, _)) = x in retTy) /// Get or set the solution of the member constraint during inference member x.Solution @@ -2386,7 +2400,7 @@ type TraitConstraintInfo = [] member x.DebugText = x.ToString() - override x.ToString() = "TTrait(" + x.MemberName + ")" + override x.ToString() = "TTrait(" + x.MemberLogicalName + ")" /// Represents the solution of a member constraint during inference. [] @@ -2398,7 +2412,8 @@ type TraitConstraintSln = /// ty -- the type and its instantiation /// vref -- the method that solves the trait constraint /// minst -- the generic method instantiation - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option /// FSRecdFieldSln(tinst, rfref, isSetProp) /// @@ -2418,7 +2433,8 @@ type TraitConstraintSln = /// extOpt -- information about an extension member, if any /// ilMethodRef -- the method that solves the trait constraint /// minst -- the generic method instantiation - | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst * staticTyOpt: TType option /// ClosedExprSln expr /// @@ -4951,7 +4967,7 @@ type TOp = | Return -> "Return" | Goto n -> "Goto(" + string n + ")" | Label n -> "Label(" + string n + ")" - | TraitCall info -> "TraitCall(" + info.MemberName + ")" + | TraitCall info -> "TraitCall(" + info.MemberLogicalName + ")" | LValueOp (op, vref) -> sprintf "%+A(%s)" op vref.LogicalName | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + ilMethRef.ToString() + ",..)" diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index efbda2d6561..2487daf3517 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -206,6 +206,8 @@ type TyparFlags = member WithCompatFlex: b: bool -> TyparFlags + member WithStaticReq: staticReq: Syntax.TyparStaticReq -> TyparFlags + /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint. member ComparisonConditionalOn: bool @@ -1628,7 +1630,12 @@ type TyparConstraint = [] type TraitWitnessInfo = - | TraitWitnessInfo of TTypes * string * Syntax.SynMemberFlags * TTypes * TType option + | TraitWitnessInfo of + tys: TTypes * + memberName: string * + memberFlags: SynMemberFlags * + objAndArgTys: TTypes * + returnTy: TType option override ToString: unit -> string @@ -1650,34 +1657,42 @@ type TraitConstraintInfo = | TTrait of tys: TTypes * memberName: string * - _memFlags: Syntax.SynMemberFlags * - argTys: TTypes * - returnTy: TType option * + memberFlags: Syntax.SynMemberFlags * + objAndArgTys: TTypes * + returnTyOpt: TType option * solution: TraitConstraintSln option ref override ToString: unit -> string - /// Get the argument types recorded in the member constraint. This includes the object instance type for - /// instance members. - member ArgumentTypes: TTypes - [] member DebugText: string + /// Get the types that may provide solutions for the traits + member SupportTypes: TType list + /// Get the member flags associated with the member constraint. member MemberFlags: Syntax.SynMemberFlags - /// Get the member name associated with the member constraint. - member MemberName: string + /// Get the member name associated with the member constraint. For preop + member MemberLogicalName: string + + /// Get the raw object and argument types recorded in the member constraint. This includes the object instance type + /// instance members. This may be empty for property traits e.g. + /// "(static member Zero: ^T)" + /// or unit-taking methods + /// "(static member get_Zero: unit -> ^T)" + /// See also extension members GetCompiledArgumentTypes and GetLogicalArgumentTypes + member CompiledObjectAndArgumentTypes: TTypes /// Get the return type recorded in the member constraint. - member ReturnType: TType option + member CompiledReturnType: TType option /// Get or set the solution of the member constraint during inference member Solution: TraitConstraintSln option with get, set - /// 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 /// Represents the solution of a member constraint during inference. [] @@ -1688,8 +1703,9 @@ type TraitConstraintSln = /// Indicates a trait is solved by an F# method. /// ty -- the type type its instantiation /// vref -- the method that solves the trait constraint + /// staticTyOpt -- the static type governing a static virtual call, if any /// minst -- the generic method instantiation - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst + | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option /// FSRecdFieldSln(tinst, rfref, isSetProp) /// @@ -1709,7 +1725,13 @@ type TraitConstraintSln = /// extOpt -- information about an extension member, if any /// ilMethodRef -- the method that solves the trait constraint /// minst -- the generic method instantiation - | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | ILMethSln of + ty: TType * + extOpt: ILTypeRef option * + ilMethodRef: ILMethodRef * + minst: TypeInst * + staticTyOpt: TType option /// ClosedExprSln expr /// diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index 63a45fb9b9a..511a4cc44f2 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -194,17 +194,20 @@ let mkTyparTy (tp: Typar) = | TyparKind.Type -> tp.AsType | TyparKind.Measure -> TType_measure (Measure.Var tp) -let copyTypar (tp: Typar) = +// For fresh type variables clear the StaticReq when copying because the requirement will be re-established through the +// process of type inference. +let copyTypar clearStaticReq (tp: Typar) = let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs }) + let flags = if clearStaticReq then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags Typar.New { typar_id = tp.typar_id - typar_flags = tp.typar_flags + typar_flags = flags typar_stamp = newStamp() typar_solution = tp.typar_solution typar_astype = Unchecked.defaultof<_> // Be careful to clone the mutable optional data too typar_opt_data = optData } -let copyTypars tps = List.map copyTypar tps +let copyTypars clearStaticReq tps = List.map (copyTypar clearStaticReq) tps //-------------------------------------------------------------------------- // Inference variables @@ -259,6 +262,12 @@ let stripTyparEqns ty = stripTyparEqnsAux false ty let stripUnitEqns unt = stripUnitEqnsAux false unt +/// Detect a use of a nominal type, including type abbreviations. +let (|AbbrevOrAppTy|_|) (ty: TType) = + match stripTyparEqns ty with + | TType_app (tcref, _, _) -> Some tcref + | _ -> None + //--------------------------------------------------------------------------- // These make local/non-local references to values according to whether // the item is globally stable ("published") or not. diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index e739aec4062..8a73a609316 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -122,9 +122,7 @@ val ccuOfTyconRef: eref: EntityRef -> CcuThunk option val mkTyparTy: tp: Typar -> TType -val copyTypar: tp: Typar -> Typar - -val copyTypars: tps: Typar list -> Typar list +val copyTypars: clearStaticReq: bool -> tps: Typar list -> Typar list val tryShortcutSolvedUnitPar: canShortcut: bool -> r: Typar -> Measure @@ -136,6 +134,9 @@ val stripTyparEqns: ty: TType -> TType val stripUnitEqns: unt: Measure -> Measure +/// Detect a use of a nominal type, including type abbreviations. +val (|AbbrevOrAppTy|_|): ty: TType -> TyconRef option + val mkLocalValRef: v: Val -> ValRef val mkLocalModuleRef: v: ModuleOrNamespace -> EntityRef diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e62c6f9309d..608ca6e86e5 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -11,7 +11,6 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open Internal.Utilities.Rational -open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DiagnosticsLogger @@ -285,10 +284,10 @@ and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = | Some sln -> let sln = match sln with - | ILMethSln(ty, extOpt, ilMethRef, minst) -> - ILMethSln(remapTypeAux tyenv ty, extOpt, ilMethRef, remapTypesAux tyenv minst) - | FSMethSln(ty, vref, minst) -> - FSMethSln(remapTypeAux tyenv ty, remapValRef tyenv vref, remapTypesAux tyenv minst) + | 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) | FSRecdFieldSln(tinst, rfref, isSet) -> FSRecdFieldSln(remapTypesAux tyenv tinst, remapRecdFieldRef tyenv.tyconRefRemap rfref, isSet) | FSAnonRecdFieldSln(anonInfo, tinst, n) -> @@ -326,7 +325,7 @@ and copyAndRemapAndBindTyparsFull remapAttrib tyenv tps = match tps with | [] -> tps, tyenv | _ -> - let tpsR = copyTypars tps + let tpsR = copyTypars false tps let tyenv = { tyenv with tpinst = bindTypars tps (generalizeTypars tpsR) tyenv.tpinst } (tps, tpsR) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (remapTyparConstraintsAux tyenv tporig.Constraints) @@ -972,7 +971,7 @@ type TypeEquivEnv with let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = let (TTrait(tys1, nm, mf1, argTys, retTy, _)) = traitInfo1 let (TTrait(tys2, nm2, mf2, argTys2, retTy2, _)) = traitInfo2 - mf1 = mf2 && + mf1.IsInstance = mf2.IsInstance && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && returnTypesAEquivAux erasureFlag g aenv retTy retTy2 && @@ -981,7 +980,7 @@ let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = and traitKeysAEquivAux erasureFlag g aenv witnessInfo1 witnessInfo2 = let (TraitWitnessInfo(tys1, nm, mf1, argTys, retTy)) = witnessInfo1 let (TraitWitnessInfo(tys2, nm2, mf2, argTys2, retTy2)) = witnessInfo2 - mf1 = mf2 && + mf1.IsInstance = mf2.IsInstance && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && returnTypesAEquivAux erasureFlag g aenv retTy retTy2 && @@ -2263,13 +2262,15 @@ and accFreeInWitnessArg opts (TraitWitnessInfo(tys, _nm, _mf, argTys, retTy)) ac and accFreeInTraitSln opts sln acc = match sln with - | ILMethSln(ty, _, _, minst) -> - accFreeInType opts ty - (accFreeInTypes opts minst acc) - | FSMethSln(ty, vref, minst) -> - accFreeInType opts ty + | ILMethSln(ty, _, _, minst, staticTyOpt) -> + Option.foldBack (accFreeInType opts) staticTyOpt + (accFreeInType opts ty + (accFreeInTypes opts minst acc)) + | FSMethSln(ty, vref, minst, staticTyOpt) -> + Option.foldBack (accFreeInType opts) staticTyOpt + (accFreeInType opts ty (accFreeValRefInTraitSln opts vref - (accFreeInTypes opts minst acc)) + (accFreeInTypes opts minst acc))) | FSAnonRecdFieldSln(_anonInfo, tinst, _n) -> accFreeInTypes opts tinst acc | FSRecdFieldSln(tinst, _rfref, _isSet) -> @@ -2487,22 +2488,133 @@ let checkMemberVal membInfo arity m = let checkMemberValRef (vref: ValRef) = checkMemberVal vref.MemberInfo vref.ValReprInfo vref.Range +let GetFSharpViewOfReturnType (g: TcGlobals) retTy = + match retTy with + | None -> g.unit_ty + | Some retTy -> retTy + +type TraitConstraintInfo with + member traitInfo.GetReturnType(g: TcGlobals) = + GetFSharpViewOfReturnType g traitInfo.CompiledReturnType + + member traitInfo.GetObjectType() = + match traitInfo.MemberFlags.IsInstance, traitInfo.CompiledObjectAndArgumentTypes with + | true, objTy :: _ -> + Some objTy + | _ -> + None + + // For static property traits: + // ^T: (static member Zero: ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Property, Static, [], ^T) + // and this returns + // [] + // + // For the logically equivalent static get_property traits (i.e. the property as a get_ method) + // ^T: (static member get_Zero: unit -> ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Member, Static, [], ^T) + // and this returns + // [] + // + // For instance property traits + // ^T: (member Length: int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Property, Instance, [], int) + // and this returns + // [] + // + // For the logically equivalent instance get_property traits (i.e. the property as a get_ method) + // ^T: (member get_Length: unit -> int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Method, Instance, [^T], int) + // and this returns + // [] + // + // For index property traits + // ^T: (member Item: int -> int with get) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Item, Property, Instance, [^T; int], int) + // and this returns + // [int] + member traitInfo.GetCompiledArgumentTypes() = + match traitInfo.MemberFlags.IsInstance, traitInfo.CompiledObjectAndArgumentTypes with + | true, _ :: argTys -> + argTys + | _, argTys -> + argTys + + // For static property traits: + // ^T: (static member Zero: ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, PropertyGet, Static, [], ^T) + // and this returns + // [] + // + // For the logically equivalent static get_property traits (i.e. the property as a get_ method) + // ^T: (static member get_Zero: unit -> ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Member, Static, [], ^T) + // and this returns + // [unit] + // + // For instance property traits + // ^T: (member Length: int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, PropertyGet, Instance, [^T], int) + // and this views the constraint as if it were + // [] + // + // For the logically equivalent instance get_property traits (i.e. the property as a get_ method) + // ^T: (member get_Length: unit -> int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Member, Instance, [^T], int) + // and this returns + // [unit] + // + // For index property traits + // (member Item: int -> int with get) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Item, PropertyGet, [^T; int], int) + // and this returns + // [int] + member traitInfo.GetLogicalArgumentTypes(g: TcGlobals) = + match traitInfo.GetCompiledArgumentTypes(), traitInfo.MemberFlags.MemberKind with + | [], SynMemberKind.Member -> [g.unit_ty] + | argTys, _ -> argTys + + member traitInfo.MemberDisplayNameCore = + let traitName0 = traitInfo.MemberLogicalName + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertyGet + | SynMemberKind.PropertySet -> + match PrettyNaming.TryChopPropertyName traitName0 with + | Some nm -> nm + | None -> traitName0 + | _ -> traitName0 + + /// Get the key associated with the member constraint. + member traitInfo.GetWitnessInfo() = + 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. /// Put these in canonical order. let GetTraitConstraintInfosOfTypars g (tps: Typars) = [ for tp in tps do - for cx in tp.Constraints do + for cx in tp.Constraints do match cx with - | TyparConstraint.MayResolveMember(traitInfo, _) -> yield traitInfo + | TyparConstraint.MayResolveMember(traitInfo, _) -> traitInfo | _ -> () ] |> ListSet.setify (traitsAEquiv g TypeEquivEnv.Empty) - |> List.sortBy (fun traitInfo -> traitInfo.MemberName, traitInfo.ArgumentTypes.Length) + |> List.sortBy (fun traitInfo -> traitInfo.MemberLogicalName, traitInfo.GetCompiledArgumentTypes().Length) /// Get information about the runtime witnesses needed for a set of generalized typars let GetTraitWitnessInfosOfTypars g numParentTypars typars = let typs = typars |> List.skip numParentTypars let cxs = GetTraitConstraintInfosOfTypars g typs - cxs |> List.map (fun cx -> cx.TraitKey) + cxs |> List.map (fun cx -> cx.GetWitnessInfo()) /// Count the number of type parameters on the enclosing type let CountEnclosingTyparsOfActualParentOfVal (v: Val) = @@ -2607,12 +2719,6 @@ let ArgInfosOfMemberVal g (v: Val) = let ArgInfosOfMember g (vref: ValRef) = ArgInfosOfMemberVal g vref.Deref -let GetFSharpViewOfReturnType (g: TcGlobals) retTy = - match retTy with - | None -> g.unit_ty - | Some retTy -> retTy - - /// Get the property "type" (getter return type) for an F# value that represents a getter or setter /// of an object model property. let ReturnTypeOfPropertyVal g (v: Val) = @@ -2674,7 +2780,7 @@ let isTTyparCoercesToType = function TyparConstraint.CoercesTo _ -> true | _ -> let prefixOfStaticReq s = match s with | TyparStaticReq.None -> "'" - | TyparStaticReq.HeadType -> " ^" + | TyparStaticReq.HeadType -> "^" let prefixOfInferenceTypar (typar: Typar) = if typar.Rigidity <> TyparRigidity.Rigid then "_" else "" @@ -2796,7 +2902,6 @@ module PrettyTypes = // Badly formed code may instantiate rigid declared typars to types. // Hence we double check here that the thing is really a type variable let safeDestAnyParTy orig g ty = match tryAnyParTy g ty with ValueNone -> orig | ValueSome x -> x - let tee f x = f x x let foldUnurriedArgInfos f z (x: UncurriedArgInfos) = List.fold (fold1Of2 f) z x let mapUnurriedArgInfos f (x: UncurriedArgInfos) = List.map (map1Of2 f) x @@ -2922,6 +3027,7 @@ module SimplifyTypes = { singletons = singletons inplaceConstraints = Zmap.ofList typarOrder inplace postfixConstraints = postfix } + let CollectInfo simplify tys cxs = categorizeConstraints simplify (accTyparCountsMulti emptyTyparCounts tys) cxs @@ -5418,11 +5524,23 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -let decideStaticOptimizationConstraint g c haveWitnesses = +// Most static optimization conditionals in FSharp.Core are +// ^T : tycon +// +// These decide positively if ^T is nominal and identical to tycon. +// These decide negatively if ^T is nominal and different to tycon. +// +// The "special" static optimization conditionals +// ^T : ^T +// 'T : 'T +// are used as hacks in FSharp.Core as follows: +// ^T : ^T --> used in (+), (-) etc. to guard witness-invoking implementations added in F# 5 +// 'T : 'T --> used in FastGenericEqualityComparer, FastGenericComparer to guard struct/tuple implementations +// +// canDecideTyparEqn is set to true in IlxGen when the witness-invoking implementation can be used. +let decideStaticOptimizationConstraint g c canDecideTyparEqn = match c with - // When witnesses are available in generic code during codegen, "when ^T : ^T" resolves StaticOptimizationAnswer.Yes - // This doesn't apply to "when 'T : 'T" use for "FastGenericEqualityComparer" and others. - | TTyconEqualsTycon (a, b) when haveWitnesses && typeEquiv g a b && (match tryDestTyparTy g a with ValueSome tp -> tp.StaticReq = TyparStaticReq.HeadType | _ -> false) -> + | TTyconEqualsTycon (a, b) when canDecideTyparEqn && typeEquiv g a b && isTyparTy g a -> StaticOptimizationAnswer.Yes | TTyconEqualsTycon (a, b) -> // Both types must be nominal for a definite result @@ -5459,13 +5577,13 @@ let decideStaticOptimizationConstraint g c haveWitnesses = | ValueSome tcref1 -> if tcref1.IsStructOrEnumTycon then StaticOptimizationAnswer.Yes else StaticOptimizationAnswer.No | ValueNone -> StaticOptimizationAnswer.Unknown -let rec DecideStaticOptimizations g cs haveWitnesses = +let rec DecideStaticOptimizations g cs canDecideTyparEqn = match cs with | [] -> StaticOptimizationAnswer.Yes | h :: t -> - let d = decideStaticOptimizationConstraint g h haveWitnesses + let d = decideStaticOptimizationConstraint g h canDecideTyparEqn if d = StaticOptimizationAnswer.No then StaticOptimizationAnswer.No - elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t haveWitnesses + elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t canDecideTyparEqn else StaticOptimizationAnswer.Unknown let mkStaticOptimizationExpr g (cs, e1, e2, m) = @@ -6409,14 +6527,16 @@ let rec tyOfExpr g expr = | TOp.LValueOp (LByrefGet, v) -> destByrefTy g v.Type | TOp.LValueOp (LAddrOf readonly, v) -> mkByrefTyWithFlag g readonly v.Type | TOp.RefAddrGet readonly -> (match tinst with [ty] -> mkByrefTyWithFlag g readonly ty | _ -> failwith "bad TOp.RefAddrGet node") - | TOp.TraitCall traitInfo -> GetFSharpViewOfReturnType g traitInfo.ReturnType + | TOp.TraitCall traitInfo -> traitInfo.GetReturnType(g) | TOp.Reraise -> (match tinst with [rtn_ty] -> rtn_ty | _ -> failwith "bad TOp.Reraise node") | TOp.Goto _ | TOp.Label _ | TOp.Return -> //assert false //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)) // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty - | Expr.WitnessArg (traitInfo, _m) -> GenWitnessTy g traitInfo.TraitKey + | Expr.WitnessArg (traitInfo, _m) -> + let witnessInfo = traitInfo.GetWitnessInfo() + GenWitnessTy g witnessInfo //-------------------------------------------------------------------------- // Make applications @@ -7545,8 +7665,6 @@ let mkCallToInt16Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrins let mkCallToUInt16Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_operator_info, [[ty]], [e1], m) -let mkCallToIntOperator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_operator_info, [[ty]], [e1], m) - let mkCallToInt32Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_operator_info, [[ty]], [e1], m) let mkCallToUInt32Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_operator_info, [[ty]], [e1], m) @@ -8112,7 +8230,7 @@ let MakeArgsForTopArgs _g m argTysl tpenv = let AdjustValForExpectedValReprInfo g m (vref: ValRef) flags valReprInfo = let tps, argTysl, retTy, _ = GetValReprTypeInFSharpForm g valReprInfo vref.Type m - let tpsR = copyTypars tps + let tpsR = copyTypars false tps let tyargsR = List.map mkTyparTy tpsR let tpenv = bindTypars tps tyargsR emptyTyparInst let rtyR = instType tpenv retTy @@ -8923,10 +9041,11 @@ let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute att let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberInfo) attrs = // All extension members are compiled as static members - if isExtensionMember then false - // Anything implementing a dispatch slot is compiled as an instance member - elif membInfo.MemberFlags.IsOverrideOrExplicitImpl then true - elif not (isNil membInfo.ImplementedSlotSigs) then true + if isExtensionMember then + false + // Abstract slots, overrides and interface impls are all true to IsInstance + elif membInfo.MemberFlags.IsDispatchSlot || membInfo.MemberFlags.IsOverrideOrExplicitImpl || not (isNil membInfo.ImplementedSlotSigs) then + membInfo.MemberFlags.IsInstance else // Otherwise check attributes to see if there is an explicit instance or explicit static flag let explicitInstance, explicitStatic = @@ -10240,3 +10359,4 @@ let isFSharpExceptionTy g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.IsFSharpException | _ -> false + diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index acb6eee7361..62f76df7e64 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1480,11 +1480,7 @@ module DebugPrint = /// A set of function parameters (visitor) for folding over expressions type ExprFolder<'State> = - { exprIntercept: ('State -> Expr -> 'State) (* noInterceptF *) - -> ('State -> Expr -> 'State) - -> 'State - -> Expr - -> 'State (* recurseF *) + { exprIntercept: ('State -> Expr -> 'State) -> ('State -> Expr -> 'State) -> 'State -> Expr -> 'State valBindingSiteIntercept: 'State -> bool * Val -> 'State nonRecBindingsIntercept: 'State -> Binding -> 'State recBindingsIntercept: 'State -> Bindings -> 'State @@ -1496,10 +1492,10 @@ type ExprFolder<'State> = val ExprFolder0: ExprFolder<'State> /// Fold over all the expressions in an implementation file -val FoldImplFile: ExprFolder<'State> -> ('State -> CheckedImplFile -> 'State) +val FoldImplFile: ExprFolder<'State> -> 'State -> CheckedImplFile -> 'State /// Fold over all the expressions in an expression -val FoldExpr: ExprFolder<'State> -> ('State -> Expr -> 'State) +val FoldExpr: ExprFolder<'State> -> 'State -> Expr -> 'State #if DEBUG /// Extract some statistics from an expression @@ -2089,8 +2085,6 @@ val mkCallToInt16Operator: TcGlobals -> range -> TType -> Expr -> Expr val mkCallToUInt16Operator: TcGlobals -> range -> TType -> Expr -> Expr -val mkCallToIntOperator: TcGlobals -> range -> TType -> Expr -> Expr - val mkCallToInt32Operator: TcGlobals -> range -> TType -> Expr -> Expr val mkCallToUInt32Operator: TcGlobals -> range -> TType -> Expr -> Expr @@ -2382,7 +2376,8 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -val DecideStaticOptimizations: TcGlobals -> StaticOptimization list -> haveWitnesses: bool -> StaticOptimizationAnswer +val DecideStaticOptimizations: + TcGlobals -> StaticOptimization list -> canDecideTyparEqn: bool -> StaticOptimizationAnswer val mkStaticOptimizationExpr: TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr @@ -2663,3 +2658,21 @@ val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option /// Indicates if an F# type is the type associated with an F# exception declaration val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool + +type TraitConstraintInfo with + + /// Get the argument types recorded in the member constraint suitable for building a TypedTree call. + member GetCompiledArgumentTypes: unit -> TType list + + /// Get the argument types when the trait is used as a first-class value "^T.TraitName" which can then be applied + member GetLogicalArgumentTypes: g: TcGlobals -> TType list + + member GetObjectType: unit -> TType option + + member GetReturnType: g: TcGlobals -> TType + + /// Get the name of the trait for textual call. + member MemberDisplayNameCore: string + + /// Get the key associated with the member constraint. + member GetWitnessInfo: unit -> TraitWitnessInfo diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 87308b2409e..a02afa72605 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1514,9 +1514,9 @@ let p_anonInfo x st = let p_trait_sln sln st = match sln with - | ILMethSln(a, b, c, d) -> + | 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) -> + | FSMethSln(a, b, c, None) -> p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a, b, c) st | BuiltInSln -> p_byte 2 st @@ -1526,6 +1526,10 @@ let p_trait_sln sln st = p_byte 4 st; p_tup3 p_tys p_rfref p_bool (a, b, c) st | FSAnonRecdFieldSln(a, b, c) -> 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) -> + 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 = @@ -1544,10 +1548,10 @@ let u_trait_sln st = match tag with | 0 -> let a, b, c, d = u_tup4 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys st - ILMethSln(a, b, c, d) + ILMethSln(a, b, c, d, None) | 1 -> let a, b, c = u_tup3 u_ty u_vref u_tys st - FSMethSln(a, b, c) + FSMethSln(a, b, c, None) | 2 -> BuiltInSln | 3 -> @@ -1558,6 +1562,12 @@ let u_trait_sln st = | 5 -> let a, b, c = u_tup3 u_anonInfo u_tys u_int st FSAnonRecdFieldSln(a, b, c) + | 6 -> + let a, b, c, d, e = u_tup5 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys u_ty 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) | _ -> ufailwith st "u_trait_sln" let u_trait st = diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 001dc57bc2d..24d25c1a1c7 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -680,7 +680,7 @@ signatureFile: moduleIntro: | moduleKeyword opt_attributes opt_access opt_rec path { if not (isNil $2) then - parseState.LexBuffer.CheckLanguageFeatureErrorRecover LanguageFeature.AttributesToRightOfModuleKeyword <| rhs parseState 4 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.AttributesToRightOfModuleKeyword (rhs parseState 4) let mModule = rhs parseState 1 mModule, $4, $5.LongIdent, $3, $2 } @@ -994,7 +994,9 @@ tyconSpfnRhs: | DELEGATE OF topType { let m = lhs parseState let ty, arity = $3 - let invoke = SynMemberSig.Member(SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero), AbstractMemberFlags SynMemberFlagsTrivia.Zero SynMemberKind.Member, m) + let flags = AbstractMemberFlags true SynMemberFlagsTrivia.Zero SynMemberKind.Member + let valSig = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) + let invoke = SynMemberSig.Member(valSig, flags, m) (fun nameRange nameInfo mEquals augmentation -> if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) let mWhole = unionRanges nameRange m @@ -1081,9 +1083,10 @@ classMemberSpfn: match optLiteralValue with | None -> m | Some e -> unionRanges m e.Range - let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, mWhole, { ValKeyword = None; WithKeyword = mWith; EqualsRange = mEquals }) - let _, flags = $3 - SynMemberSig.Member(valSpfn, flags (getSetAdjuster arity), mWhole) } + let trivia = { ValKeyword = None; WithKeyword = mWith; EqualsRange = mEquals } + let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, mWhole, trivia) + let flags = $3 (getSetAdjuster arity) + SynMemberSig.Member(valSpfn, flags, mWhole) } | opt_attributes opt_declVisibility interfaceMember appType { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) @@ -1156,13 +1159,7 @@ classMemberSpfnGetSetElements: memberSpecFlags: | memberFlags { $1 } - | ABSTRACT - { let mAbstract = rhs parseState 1 - (false, AbstractMemberFlags(AbstractSynMemberFlagsTrivia mAbstract)) } - | ABSTRACT MEMBER - { let mAbstract = rhs parseState 1 - let mMember = rhs parseState 2 - (false, AbstractMemberFlags(AbstractMemberSynMemberFlagsTrivia mAbstract mMember)) } + | abstractMemberFlags { $1 } /* Part of an exception definition in a signature file */ @@ -1598,16 +1595,16 @@ memberFlags: | STATIC MEMBER { let mStatic = rhs parseState 1 let mMember = rhs parseState 2 - (true, StaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember)) } + StaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember) } | MEMBER { let mMember = rhs parseState 1 - (false, NonVirtualMemberFlags(MemberSynMemberFlagsTrivia mMember)) } + NonVirtualMemberFlags(MemberSynMemberFlagsTrivia mMember) } | OVERRIDE { let mOverride = rhs parseState 1 - (false, OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride)) } + OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride) } | DEFAULT { let mDefault = rhs parseState 1 - (false, OverrideMemberFlags(DefaultSynMemberFlagsTrivia mDefault)) } + OverrideMemberFlags(DefaultSynMemberFlagsTrivia mDefault) } /* The name of a type in a signature or implementation, possibly with type parameters and constraints */ typeNameInfo: @@ -1743,8 +1740,9 @@ tyconDefnRhs: { let m = lhs parseState let ty, arity = $3 (fun nameRange augmentation -> - let valSpfn = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) - let invoke = SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags SynMemberFlagsTrivia.Zero SynMemberKind.Member, m) + let valSig = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) + let flags = AbstractMemberFlags true SynMemberFlagsTrivia.Zero SynMemberKind.Member + let invoke = SynMemberDefn.AbstractSlot(valSig, flags, m) if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Delegate (ty, arity), [invoke], m), []) } @@ -1841,6 +1839,7 @@ classDefnMemberGetSet: classDefnMemberGetSetElements: | classDefnMemberGetSetElement { [$1], None } + | classDefnMemberGetSetElement AND classDefnMemberGetSetElement { let mAnd = rhs parseState 2 [$1;$3], Some mAnd } @@ -1877,16 +1876,34 @@ memberCore: let optPropertyType = $3 mkSynMemberDefnGetSet parseState $1 mWith classDefnMemberGetSetElements mAnd mWhole propertyNameBindingPat optPropertyType } - abstractMemberFlags: | ABSTRACT { let mAbstract = rhs parseState 1 - AbstractSynMemberFlagsTrivia mAbstract } - | ABSTRACT MEMBER + AbstractMemberFlags true (AbstractSynMemberFlagsTrivia mAbstract) } + + | ABSTRACT MEMBER { let mAbstract = rhs parseState 1 let mMember = rhs parseState 2 - AbstractMemberSynMemberFlagsTrivia mAbstract mMember } - + AbstractMemberFlags true (AbstractMemberSynMemberFlagsTrivia mAbstract mMember) } + + | STATIC ABSTRACT + { let mWhole = rhs2 parseState 1 2 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole + if parseState.LexBuffer.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), mWhole)) + let mStatic = rhs parseState 1 + let mAbstract = rhs parseState 2 + AbstractMemberFlags false (StaticAbstractSynMemberFlagsTrivia mStatic mAbstract) } + + | STATIC ABSTRACT MEMBER + { let mWhole = rhs2 parseState 1 2 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole + if parseState.LexBuffer.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), mWhole)) + let mStatic = rhs parseState 1 + let mAbstract = rhs parseState 2 + let mMember = rhs parseState 3 + AbstractMemberFlags false (StaticAbstractMemberSynMemberFlagsTrivia mStatic mAbstract mMember) } /* A member definition */ classDefnMember: @@ -1902,7 +1919,7 @@ classDefnMember: { let rangeStart = rhs parseState 1 if Option.isSome $2 then errorR (Error (FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier (), rhs parseState 2)) - let _, flags = $3 + let flags = $3 $4 $2 flags $1 rangeStart } | opt_attributes opt_declVisibility interfaceMember appType opt_interfaceImplDefn @@ -1926,8 +1943,9 @@ classDefnMember: | Some m2 -> unionRanges m m2 |> unionRangeWithXmlDoc doc if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), mWhole)) - let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, mWhole, { ValKeyword = None; WithKeyword = mWith; EqualsRange = None }) - [ SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags $3 (getSetAdjuster arity), mWhole) ] } + let trivia = { ValKeyword = None; WithKeyword = mWith; EqualsRange = None } + let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, mWhole, trivia) + [ SynMemberDefn.AbstractSlot(valSpfn, $3 (getSetAdjuster arity), mWhole) ] } | opt_attributes opt_declVisibility inheritsDefn { if not (isNil $1) then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(), rhs parseState 1)) @@ -1948,8 +1966,8 @@ classDefnMember: { let rangeStart = rhs parseState 1 if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) - let isStatic, flags = $3 - $4 $1 isStatic flags rangeStart } + let flags = $3 + $4 $1 flags rangeStart } | opt_attributes opt_declVisibility NEW atomicPattern optAsSpec EQUALS typedSequentialExprBlock opt_ODECLEND { let mWholeBindLhs = rhs2 parseState 1 (if Option.isSome $5 then 5 else 4) @@ -1989,11 +2007,13 @@ autoPropsDefnDecl: let mEquals = rhs parseState 6 if $2 then errorR (Error (FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSet (), rhs parseState 3)) - (fun attribs isStatic flags rangeStart -> + (fun attribs flags rangeStart -> let xmlDoc = grabXmlDocAtRangeStart(parseState, attribs, rangeStart) let memberRange = unionRanges rangeStart $7.Range |> unionRangeWithXmlDoc xmlDoc - [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, flags, xmlDoc, $3, mEquals, $7, mWith, mGetSetOpt, memberRange) ]) } - + let memberFlags = flags SynMemberKind.Member + let memberFlagsForSet = flags SynMemberKind.PropertySet + let isStatic = not memberFlags.IsInstance + [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, memberFlags, memberFlagsForSet, xmlDoc, $3, mEquals, $7, mWith, mGetSetOpt, memberRange) ]) } /* An optional type on an auto-property definition */ opt_typ: @@ -2152,28 +2172,32 @@ objectImplementationMembers: /* One member in an object expression or interface implementation */ objectImplementationMember: - | opt_attributes memberOrOverride memberCore opt_ODECLEND + | opt_attributes staticMemberOrMemberOrOverride memberCore opt_ODECLEND { let rangeStart = rhs parseState 1 - $3 None (OverrideMemberFlags $2) $1 rangeStart } + $3 None $2 $1 rangeStart } - | opt_attributes memberOrOverride autoPropsDefnDecl opt_ODECLEND + | opt_attributes staticMemberOrMemberOrOverride autoPropsDefnDecl opt_ODECLEND { let rangeStart = rhs parseState 1 - $3 $1 false (OverrideMemberFlags $2) rangeStart } + $3 $1 $2 rangeStart } - | opt_attributes memberOrOverride error + | opt_attributes staticMemberOrMemberOrOverride error { [] } | opt_attributes error memberCore opt_ODECLEND { [] } -memberOrOverride: +staticMemberOrMemberOrOverride: + | STATIC MEMBER + { let mStatic = rhs parseState 1 + let mMember = rhs parseState 2 + ImplementStaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember) } | MEMBER { let mMember = rhs parseState 1 - MemberSynMemberFlagsTrivia mMember } + OverrideMemberFlags(MemberSynMemberFlagsTrivia mMember) } | OVERRIDE { let mOverride = rhs parseState 1 - OverrideSynMemberFlagsTrivia mOverride } + OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride) } /* The core of the right-hand-side of a simple type definition */ @@ -2369,7 +2393,7 @@ typeConstraint: { let tp = $1 SynTypeConstraint.WhereTyparSupportsMember([ SynType.Var(tp, tp.Range) ], $4, lhs parseState) } - | LPAREN typarAlts rparen COLON LPAREN classMemberSpfn rparen + | LPAREN typeAlts rparen COLON LPAREN classMemberSpfn rparen { SynTypeConstraint.WhereTyparSupportsMember(List.rev($2), $6, lhs parseState) } | typar COLON DELEGATE typeArgsNoHpaDeprecated @@ -2390,8 +2414,11 @@ typeConstraint: | "unmanaged" -> SynTypeConstraint.WhereTyparIsUnmanaged($1, lhs parseState) | nm -> raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedIdentifier(nm)) } -typarAlts: - | typarAlts OR appType + | appType + { SynTypeConstraint.WhereSelfConstrained($1, lhs parseState) } + +typeAlts: + | typeAlts OR appType { $3 :: $1 } | appType @@ -3963,7 +3990,7 @@ declExpr: { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression(">")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 ">" (arbExpr("declExprInfix", (rhs parseState 3).StartRange))) } - | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON + | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON %prec infix_at_hat_op_binary { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix", (rhs parseState 3).StartRange))) } @@ -4016,13 +4043,6 @@ declExpr: { let m = rhs parseState 1 SynExpr.IndexRange(None, m, None, m, m, m) } - | INFIX_AT_HAT_OP declExpr - { if not (parseState.LexBuffer.SupportsFeature LanguageFeature.FromEndSlicing) then - raiseParseErrorAt (rhs parseState 1) (FSComp.SR.fromEndSlicingRequiresVFive()) - if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) - let m = (rhs2 parseState 1 2) - SynExpr.IndexFromEnd($2, m) } - | minusExpr %prec expr_prefix_plus_minus { $1 } dynamicArg: @@ -4215,6 +4235,11 @@ tupleExpr: [arbExpr ("tupleExpr4", commaRange.EndRange); arbExpr ("tupleExpr5", commaRange.StartRange)], [commaRange] } minusExpr: + | INFIX_AT_HAT_OP minusExpr + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) + let m = (rhs2 parseState 1 2) + SynExpr.IndexFromEnd($2, m) } + | MINUS minusExpr %prec expr_prefix_plus_minus { mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) "~-" $2 } @@ -4263,7 +4288,7 @@ appExpr: | appExpr argExpr %prec expr_app { SynExpr.App (ExprAtomicFlag.NonAtomic, false, $1, $2, unionRanges $1.Range $2.Range) } - | atomicExpr + | atomicExpr { let arg, _ = $1 arg } @@ -4301,6 +4326,12 @@ atomicExpr: if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefixPrim (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) $1 arg2, hpa2 } + | QUOTE ident + { let id = mkSynId (lhs parseState) ($2).idText + let typar = SynTypar(id, TyparStaticReq.None, false) + let lhsm = rhs2 parseState 1 2 + SynExpr.Typar(typar, lhsm), false } + | atomicExpr DOT atomicExprQualification { let arg1, hpa1 = $1 $3 arg1 (lhs parseState) (rhs parseState 2), hpa1 } @@ -4547,7 +4578,7 @@ parenExpr: //arbExpr("parenExpr2", mLhs) } parenExprBody: - | staticallyKnownHeadTypars COLON LPAREN classMemberSpfn rparen typedSequentialExpr + | typars COLON LPAREN classMemberSpfn rparen typedSequentialExpr { (fun m -> SynExpr.TraitCall ($1, $4, $6, m)) } /* disambiguate: x $a.id(x) */ | typedSequentialExpr @@ -4556,19 +4587,19 @@ parenExprBody: | inlineAssemblyExpr { $1 } -staticallyKnownHeadTypars: - | staticallyKnownHeadTypar - { [$1] } +typars: + | typar + { [SynType.Var($1, rhs parseState 1)] } - | LPAREN staticallyKnownHeadTyparAlts rparen + | LPAREN typarAlts rparen { List.rev $2 } -staticallyKnownHeadTyparAlts: - | staticallyKnownHeadTyparAlts OR staticallyKnownHeadTypar +typarAlts: + | typarAlts OR appType {$3 :: $1} - | staticallyKnownHeadTypar - { [$1] } + | typar + { [SynType.Var($1, rhs parseState 1)] } braceExpr: | LBRACE braceExprBody rbrace @@ -5447,12 +5478,8 @@ typar: { let id = mkSynId (lhs parseState) ($2).idText SynTypar(id, TyparStaticReq.None, false) } - | staticallyKnownHeadTypar - { $1 } - -staticallyKnownHeadTypar: | INFIX_AT_HAT_OP ident - { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedTypeParameter()); + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.tcUnexpectedSymbolInTypeExpression($1)); let id = mkSynId (lhs parseState) ($2).idText SynTypar(id, TyparStaticReq.HeadType, false) } diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 8052182cecb..2d82749b568 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -187,6 +187,11 @@ Notace expr[idx] pro indexování a vytváření řezů + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ obnovitelné stavové stroje + + self type constraints + self type constraints + + single underscore pattern vzor s jedním podtržítkem @@ -537,6 +547,16 @@ Neočekávaný token v definici typu. Za typem {0} se očekává =. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ Konstruktor {0} je možné použít jenom v platném obnovitelném kódu. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Použití [<Struct>] u hodnot, funkcí a metod je povolené jenom u částečných aktivních definic vzorů. @@ -882,11 +907,46 @@ Tento výraz implicitně převede typ {0} na typ {1}. Přečtěte si téma https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Neplatný interpolovaný řetězec. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Člen rozhraní {0} nemá nejvíce specifickou implementaci. @@ -3157,11 +3217,6 @@ Neočekávaný celočíselný literál ve výrazu měrné jednotky - - Syntax error: unexpected type parameter specification - Chyba syntaxe: neočekávaná specifikace parametru typu - - Mismatched quotation operator name, beginning with '{0}' Neshoda v názvu operátoru citace (začíná na {0}) diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 3d3dc8c2604..52b86aed72b 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -187,6 +187,11 @@ expr[idx]-Notation zum Indizieren und Aufteilen + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ Fortsetzbarer Zustand-Maschinen + + self type constraints + self type constraints + + single underscore pattern Muster mit einzelnem Unterstrich @@ -537,6 +547,16 @@ Unerwartetes Token in Typdefinition. Nach Typ "{0}" wurde "=" erwartet. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ Das Konstrukt "{0}" darf nur in einem gültigen fortsetzbaren Code verwendet werden. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Die Verwendung von "[<Struct>]" für Werte, Funktionen und Methoden ist nur für partielle aktive Musterdefinitionen zulässig. @@ -882,11 +907,46 @@ Dieser Ausdruck konvertiert den Typ "{0}" implizit in den Typ "{1}". Siehe https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Ungültige interpolierte Zeichenfolge. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Der Schnittstellenmember "{0}" weist keine spezifischste Implementierung auf. @@ -3157,11 +3217,6 @@ Unerwartetes Integer-Literal in Maßeinheitenausdruck. - - Syntax error: unexpected type parameter specification - Syntaxfehler: Unerwartete Typparameterangabe. - - Mismatched quotation operator name, beginning with '{0}' Anführungszeichen-Operatorname stimmt nicht überein, beginnt mit "{0}". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index ba19316436e..e69b208bdab 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -187,6 +187,11 @@ Notación para indexación y segmentación expr[idx] + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ máquinas de estado reanudables + + self type constraints + self type constraints + + single underscore pattern patrón de subrayado simple @@ -537,6 +547,16 @@ Token inesperado en la definición de tipo. Se esperaba "=" después del tipo "{0}". + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ La construcción "{0}" solo se puede usar en un código reanudable válido. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions El uso de «[<Struct>]» en valores, funciones y métodos solo se permite en definiciones de modelos activos parciales. @@ -882,11 +907,46 @@ Esta expresión convierte implícitamente el tipo '{0}' al tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Cadena interpolada no válida. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. El miembro de interfaz "{0}" no tiene una implementación más específica. @@ -3157,11 +3217,6 @@ Literal entero inesperado en una expresión de unidad de medida. - - Syntax error: unexpected type parameter specification - Error de sintaxis: especificación de parámetro de tipo inesperada. - - Mismatched quotation operator name, beginning with '{0}' Falta el elemento de clausura en un nombre de operador de expresión de código delimitada que comienza con '{0}'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 4ed2c0da2a9..c7f3073a0f0 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -187,6 +187,11 @@ Notation expr[idx] pour l’indexation et le découpage + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ ordinateurs d’état pouvant être repris + + self type constraints + self type constraints + + single underscore pattern modèle de trait de soulignement unique @@ -537,6 +547,16 @@ Jeton inattendu dans la définition de type. Signe '=' attendu après le type '{0}'. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ La construction «{0}» ne peut être utilisée que dans un code pouvant être repris valide. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions L’utilisation de' [<Struct>] 'sur les valeurs, les fonctions et les méthodes n’est autorisée que sur les définitions de modèle actif partiel @@ -882,11 +907,46 @@ Cette expression convertit implicitement le type « {0} » en type « {1} ». Voir https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Chaîne interpolée non valide. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Le membre d'interface '{0}' n'a pas l'implémentation la plus spécifique. @@ -3157,11 +3217,6 @@ Littéral d'entier inattendu dans l'expression de l'unité de mesure - - Syntax error: unexpected type parameter specification - Erreur de syntaxe : spécification du paramètre de type inattendue - - Mismatched quotation operator name, beginning with '{0}' Incompatibilité du nom d'opérateur de quotation, qui commence par '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 01af391840a..7ab7a0e3624 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -187,6 +187,11 @@ Notazione expr[idx] per l'indicizzazione e il sezionamento + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ macchine a stati ripristinabili + + self type constraints + self type constraints + + single underscore pattern criterio per carattere di sottolineatura singolo @@ -537,6 +547,16 @@ Token imprevisto nella definizione del tipo. Dopo il tipo '{0}' è previsto '='. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ Il costrutto '{0}' può essere usato solo in codice ripristinabile valido. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions L'utilizzo di '[<Struct>]' su valori, funzioni e metodi è consentito solo per definizioni di criteri attivi parziali @@ -882,11 +907,46 @@ Questa espressione converte in modo implicito il tipo '{0}' nel tipo '{1}'. Vedere https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} La stringa interpolata non è valida. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Il membro di interfaccia '{0}' non contiene un'implementazione più specifica. @@ -3157,11 +3217,6 @@ Valore letterale Integer non previsto in espressione di unità di misura - - Syntax error: unexpected type parameter specification - Errore di sintassi: specifica di parametro di tipo non prevista - - Mismatched quotation operator name, beginning with '{0}' Nome operatore di quotation non corrispondente con '{0}' iniziale diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 54fbab4b514..71459f7af76 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -187,6 +187,11 @@ インデックス作成とスライス用の expr[idx] 表記 + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ 再開可能なステート マシン + + self type constraints + self type constraints + + single underscore pattern 単一のアンダースコア パターン @@ -537,6 +547,16 @@ 型定義に予期しないトークンがあります。型 '{0}' の後には '=' が必要です。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ コンストラクト '{0}' は、有効な再開可能コードでのみ使用できます。 + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 値、関数、およびメソッドでの '[<Struct>]' は、部分的なアクティブ パターンの定義でのみ使うことができます @@ -882,11 +907,46 @@ この式は、型 '{0}' を型 '{1}' に暗黙的に変換します。https://aka.ms/fsharp-implicit-convs を参照してください。 + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 補間された文字列が無効です。{0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. インターフェイス メンバー '{0}' には最も固有な実装がありません。 @@ -3157,11 +3217,6 @@ 単位式に予期しない整数リテラルが見つかりました - - Syntax error: unexpected type parameter specification - 構文エラー: 予期しない型パラメーターが指定されました - - Mismatched quotation operator name, beginning with '{0}' '{0}' で始まる演算子名の引用符が対応しません diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 7ed437b2763..1f448706202 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -187,6 +187,11 @@ 인덱싱 및 슬라이싱을 위한 expr[idx] 표기법 + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ 다시 시작 가능한 상태 시스템 + + self type constraints + self type constraints + + single underscore pattern 단일 밑줄 패턴 @@ -537,6 +547,16 @@ 형식 정의에 예기치 않은 토큰이 있습니다. '{0}' 형식 뒤에 '='가 필요합니다. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ '{0}' 구문은 유효한 다시 시작 가능한 코드에서만 사용할 수 있습니다. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 값, 함수 및 메서드에 '[<Struct>]'을(를) 사용하는 것은 부분 활성 패턴 정의에서만 허용됩니다. @@ -882,11 +907,46 @@ 이 식은 암시적으로 '{0}' 형식을 '{1}' 형식으로 변환 합니다. https://aka.ms/fsharp-implicit-convs 참조 + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 잘못된 보간 문자열. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 인터페이스 멤버 '{0}'에 가장 한정적인 구현이 없습니다. @@ -3157,11 +3217,6 @@ 측정 단위 식에 예기치 않은 정수 리터럴이 있습니다. - - Syntax error: unexpected type parameter specification - 구문 오류: 예기치 않은 형식 매개 변수 지정입니다. - - Mismatched quotation operator name, beginning with '{0}' 짝이 맞지 않는 인용구 연산자 이름('{0}'(으)로 시작)입니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 19e01c91485..27d51cc1166 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -187,6 +187,11 @@ notacja wyrażenia expr[idx] do indeksowania i fragmentowania + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ automaty stanów z możliwością wznowienia + + self type constraints + self type constraints + + single underscore pattern wzorzec z pojedynczym podkreśleniem @@ -537,6 +547,16 @@ Nieoczekiwany token w definicji typu. Oczekiwano znaku „=” po typie „{0}”. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ Konstrukcji "{0}" można używać tylko w prawidłowym kodzie z możliwością wznowienia. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Używanie elementu "[<Struct>]" na wartościach, funkcjach i metodach jest dozwolone tylko w definicjach częściowo aktywnego wzorca @@ -882,11 +907,46 @@ To wyrażenie bezwzględnie konwertuje typ "{0}" na typ "{1}". Zobacz https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Nieprawidłowy ciąg interpolowany. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Składowa interfejsu „{0}” nie ma najbardziej specyficznej implementacji. @@ -3157,11 +3217,6 @@ Nieoczekiwany literał całkowity w wyrażeniu jednostki miary - - Syntax error: unexpected type parameter specification - Błąd składni: nieoczekiwana specyfikacja parametru typu - - Mismatched quotation operator name, beginning with '{0}' Niezgodna nazwa operatora cytatu, począwszy od „{0}” diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 615e716bd0f..12715e0af25 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -187,6 +187,11 @@ notação expr[idx] para indexação e fatia + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ máquinas de estado retomável + + self type constraints + self type constraints + + single underscore pattern padrão de sublinhado simples @@ -537,6 +547,16 @@ Token inesperado na definição de tipo. Esperava-se '=' após o tipo '{0}'. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ A construção '{0}' só pode ser usada em código válido e retomável. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions O uso de '[<Struct>]' em valores, funções e métodos somente é permitido em definições de padrões ativos parciais @@ -882,11 +907,46 @@ Essa expressão converte implicitamente o tipo '{0}' ao tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Cadeia de caracteres interpolada inválida. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. O membro de interface '{0}' não tem uma implementação mais específica. @@ -3157,11 +3217,6 @@ Literal de inteiro inesperado na expressão de unidade de medida - - Syntax error: unexpected type parameter specification - Erro de sintaxe: especificação de parâmetro de tipo inesperada - - Mismatched quotation operator name, beginning with '{0}' Nome de operador de cotação incompatível, começando com '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index f534378e99f..f9811a79041 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -187,6 +187,11 @@ expr[idx] для индексации и среза + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ возобновляемые конечные автоматы + + self type constraints + self type constraints + + single underscore pattern шаблон с одним подчеркиванием @@ -537,6 +547,16 @@ Неожиданный токен в определении типа. После типа "{0}" ожидается "=". + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ Конструкция "{0}" может использоваться только в допустимом возобновляемом коде. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Использование "[<Struct>]" для значений, функций и методов разрешено только для определений частичных активных шаблонов @@ -882,11 +907,46 @@ Это выражение неявно преобразует тип "{0}" в тип "{1}". См. сведения на странице https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Недопустимая интерполированная строка. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Элемент интерфейса "{0}" не имеет наиболее конкретной реализации. @@ -3157,11 +3217,6 @@ Недопустимый целочисленный литерал в выражении единицы измерения - - Syntax error: unexpected type parameter specification - Синтаксическая ошибка: недопустимая спецификация параметра типа - - Mismatched quotation operator name, beginning with '{0}' Несоответствующее имя оператора кавычки, начиная с "{0}" diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 70335d09d9d..53c8f5dd0ea 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -187,6 +187,11 @@ Dizin oluşturma ve dilimleme için expr[idx] gösterimi + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ sürdürülebilir durum makineleri + + self type constraints + self type constraints + + single underscore pattern tek alt çizgi deseni @@ -537,6 +547,16 @@ Tür tanımında beklenmeyen belirteç var. '{0}' türünden sonra '=' bekleniyordu. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ '{0}' yapısı yalnızca geçerli sürdürülebilir kodda kullanılabilir. + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Değerlerde, işlevlerde ve yöntemlerde '[<Struct>]' kullanımına yalnızca kısmi etkin desen tanımlarında izin veriliyor @@ -882,11 +907,46 @@ Bu ifade '{0}' türünü örtülü olarak '{1}' türüne dönüştürür. https://aka.ms/fsharp-implicit-convs adresine bakın. + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Geçersiz düz metin arasına kod eklenmiş dize. {0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. '{0}' arabirim üyesinin en belirgin uygulaması yok. @@ -3157,11 +3217,6 @@ Ölçü birimi ifadesinde beklenmeyen tamsayı sabit değeri - - Syntax error: unexpected type parameter specification - Sözdizimi hatası: beklenmeyen tür parametresi belirtimi - - Mismatched quotation operator name, beginning with '{0}' '{0}' ile başlayan, eşleşmeyen alıntı işleci adı diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 4e7e55a375c..63d553b7ff0 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -187,6 +187,11 @@ 用于索引和切片的 expr[idx] 表示法 + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ 可恢复状态机 + + self type constraints + self type constraints + + single underscore pattern 单下划线模式 @@ -537,6 +547,16 @@ 类型定义中出现意外标记。类型“{0}”后应为 "="。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ 构造 "{0}" 只能在有效的可恢复代码中使用。 + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 只允许在部分活动模式定义中对值、函数和方法使用 "[<Struct>]" @@ -882,11 +907,46 @@ 此表达式将类型“{0}”隐式转换为类型“{1}”。请参阅 https://aka.ms/fsharp-implicit-convs。 + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 内插字符串无效。{0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 接口成员“{0}”没有最具体的实现。 @@ -3157,11 +3217,6 @@ 度量单位表达式中意外的整数文本 - - Syntax error: unexpected type parameter specification - 语法错误: 意外的类型参数规范 - - Mismatched quotation operator name, beginning with '{0}' 不匹配的引用运算符名称(以“{0}”开头) diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 965a9c231b6..72cc95c1944 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -187,6 +187,11 @@ 用於編製索引和分割的 expr[idx] 註釋 + + static abstract interface members + static abstract interface members + + support for consuming init properties support for consuming init properties @@ -272,6 +277,11 @@ 可繼續的狀態機器 + + self type constraints + self type constraints + + single underscore pattern 單一底線模式 @@ -537,6 +547,16 @@ 型別定義中出現非預期的權杖。類型 '{0}' 之後應該要有 '='。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + Expecting expression Expecting expression @@ -747,6 +767,11 @@ 建構 '{0}' 只能用於有效的可繼續程式碼。 + + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 只允許在部分現用模式定義上對值、函式和方法使用 '[<Struct>]' @@ -882,11 +907,46 @@ 此運算式將類型 '{0}' 隱含轉換為類型 '{1}'。請參閱 https://aka.ms/fsharp-implicit-convs。 + + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + + + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 插補字串無效。{0} + + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 介面成員 '{0}' 沒有最具體的實作。 @@ -3157,11 +3217,6 @@ 測量單位運算式中未預期的整數常值 - - Syntax error: unexpected type parameter specification - 語法錯誤: 未預期的型別參數規格 - - Mismatched quotation operator name, beginning with '{0}' 不相符的引號運算子名稱，以 '{0}' 開頭 diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index 5fcd59b4375..9d67b00e5bc 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -4,14 +4,15 @@ Library - netstandard2.0 + netstandard2.0 + netstandard2.0 FSharp.Build $(NoWarn);75 true $(DefineConstants);LOCALIZATION_FSBUILD NU1701;FS0075 true - 6.0 + 6.0 Debug;Release;Proto @@ -58,7 +59,7 @@ The FSharp.Build built here may be loaded directly into a shipped Visual Studio, to that end, we cannot rely on new API's just being added to FSharp.Core. --> - + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/SymbolicOperators.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/SymbolicOperators.fs index b31c2d07bb1..aa8cddcba33 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/SymbolicOperators.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/SymbolicOperators.fs @@ -39,7 +39,7 @@ module SymbolicOperators = |> compile |> shouldFail |> withErrorCode 0670 - |> withDiagnosticMessageMatches " \^a\) could not be generalized because it would escape its scope" + |> withDiagnosticMessageMatches " \^a\) could not be generalized because it would escape its scope" |> ignore // This test was automatically generated (moved from FSharpQA suite - Conformance/LexicalAnalysis/SymbolicOperators) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs new file mode 100644 index 00000000000..7ff2a44aaf1 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -0,0 +1,831 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +module FSharp.Compiler.ComponentTests.Conformance.TypeAndTypeConstraints.IWSAMsAndSRTPs + +open Xunit +open System.IO +open FSharp.Test +open FSharp.Test.Compiler + +let typesModule = + FSharp (loadSourceFromFile (Path.Combine(__SOURCE_DIRECTORY__, "Types.fs"))) + |> withName "Types" + |> withLangVersionPreview + |> withOptions ["--nowarn:3535"] + +let setupCompilation compilation = + compilation + |> asExe + |> withLangVersionPreview + |> withReferences [typesModule] + + +#if !NETCOREAPP +[] +#else +[] +#endif +let ``IWSAM test files`` compilation = + compilation + |> setupCompilation + |> compileAndRun + |> shouldSucceed + +[] +[ ^T")>] +[ 'T")>] + +[ int when ^T: (static member A: int)")>] + +[ int when (^T or int) : (static member A: int)")>] + +[ int when (^U or ^T) : (static member A: int)")>] + +[ unit")>] +[ unit when ^T: (byte|int16|int32|int64|sbyte|uint16|uint32|uint64|nativeint|unativeint)")>] +[ uint32) (value)) + let inline uint value = uint32 value""", + "val inline uint: value: ^a -> uint32 when ^a: (static member op_Explicit: ^a -> uint32)")>] + +[ 'a -> int) -> x: 'a -> y: 'a -> bool")>] +let ``Check static type parameter inference`` code expectedSignature = + FSharp code + |> ignoreWarnings + |> withLangVersionPreview + |> signaturesShouldContain expectedSignature + + +[] +let ``Static type parameter inference in version 6`` () = + FSharp """ + let inline f0 (x: ^T) = x + let g0 (x: 'T) = f0 x""" + |> withLangVersion60 + |> signaturesShouldContain "val g0: x: obj -> obj" + + +module ``Equivalence of properties and getters`` = + + [] + [() = (^T : (static member StaticProperty: int) ())")>] + [ int) >() = (^T : (static member get_StaticProperty: unit -> int) ())")>] + [ int) >() = (^T : (static member StaticProperty: int) ())")>] + [() = (^T : (static member get_StaticProperty: unit -> int) ())")>] + [() = 'T.StaticProperty")>] + let ``Static property getter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static int32 f_StaticProperty() cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_StaticProperty is not su" + + "pported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static int32 f_StaticProperty$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 get_StaticProperty) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldnull + IL_0002: tail. + IL_0004: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0009: ret + }"""] + + [] + [() = (^T : (static member StaticProperty: int with set) (3))")>] + [ unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] + [ unit) >() = (^T : (static member StaticProperty: int with set) (3))")>] + [() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] + [() = 'T.set_StaticProperty(3)")>] + let ``Static property setter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_StaticProperty() cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_StaticProperty is not su" + + "pported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_StaticProperty$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 set_StaticProperty) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldc.i4.3 + IL_0002: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0007: pop + IL_0008: ret + }"""] + + [] + [(x: 'T) = (^T : (member Length: int) (x))")>] + [ int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] + [ int) >(x: 'T) = (^T : (member Length: int) (x))")>] + [(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] + [(x: 'T) = x.Length")>] + let ``Instance property getter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static int32 f_Length(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_Length is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static int32 f_Length$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 get_Length, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: tail. + IL_0004: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0009: ret + }"""] + + [] + [(x: 'T) = (^T : (member Length: int with set) (x, 3))")>] + [ unit) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] + [ unit) >(x: 'T) = (^T : (member Length: int with set) (x, 3))")>] + [(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] + [(x: 'T) = x.set_Length(3)")>] + let ``Instance property setter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_Length(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_Length is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_Length$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> set_Length, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, + !0, + !1) + IL_0008: pop + IL_0009: ret + }"""] + + [] + [ string with get) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3))")>] + [ string) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] + [ string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3))")>] + [ string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] + [ string with get) >(x: 'T) = x.get_Item(3)")>] + let ``Get item`` code = + Fsx code + |> withOptions ["--nowarn:77"] + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static string f_Item(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_Item is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static string f_Item$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> get_Item, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: tail. + IL_0005: call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, + !0, + !1) + IL_000a: ret + }"""] + + [] + [ string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, \"a\"))")>] + [ unit) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] + [ unit) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, \"a\"))")>] + [ string with set) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] + [ string with set) >(x: 'T) = x.set_Item(3, \"a\")")>] + let ``Set item`` code = + Fsx code + |> withOptions ["--nowarn:77"] + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_Item(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_Item is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_Item$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>> set_Item, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: ldstr "a" + IL_0008: call !!1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>>, + !0, + !1, + !!0) + IL_000d: pop + IL_000e: ret + }"""] + + +module Negative = + + [] + [ int) >() = ()")>] + [ -> int) >() = ()")>] + [ -> int) >() = ()")>] + [] x: int[] -> int) >() = ()")>] + [] x: int[] -> int) >() = ()")>] + [] Name: 'T byref -> bool)> () = ()""")>] + let ``Trait warning or error`` code = + let errorMessage = "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" + + Fsx code + |> withLangVersion60 + |> compile + |> shouldFail + |> withWarningCode 3532 + |> withDiagnosticMessage errorMessage + |> ignore + + Fsx code + |> withLangVersionPreview + |> compile + |> shouldFail + |> withErrorCode 3532 + |> withDiagnosticMessage errorMessage + |> ignore + + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``IWSAM warning`` () = + Fsx "let fExpectAWarning(x: Types.ISinOperator<'T>) = ()" + |> withReferences [typesModule] + |> compile + |> shouldFail + |> withWarningCode 3536 + |> withDiagnosticMessage """'ISinOperator<_>' is normally used as a type constraint in generic code, e.g. "'T when ISomeInterface<'T>" or "let f (x: #ISomeInterface<_>)". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn "3536"' or '--nowarn:3536'.""" + |> ignore + + [] + let ``Multiple support types trait error`` () = + Fsx "let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A" + |> compile + |> shouldFail + |> withErrorCode 3537 + |> withDiagnosticMessage "The trait 'A' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." + |> ignore + + +module InvocationBehavior = + + [] + let ``SRTP Delegate conversion not supported`` () = + Fsx "let inline f_TraitWithDelegate<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = + 'T.StaticMethod(fun x -> x + 1)" + |> compile + |> shouldFail + |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" + + [] + let ``SRTP Expression conversion not supported`` () = + Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = + 'T.StaticMethod(fun x -> x + 1)" + |> compile + |> shouldFail + |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``IWSAM Delegate conversion works`` () = + Fsx + """ + open Types + + let inline f_IwsamWithFunc<'T when IDelegateConversion<'T>>() = + 'T.FuncConversion(fun x -> x + 1) + + if not (f_IwsamWithFunc().Value = 4) then + failwith "Unexpected result" + + """ + |> setupCompilation + |> compileAndRun + |> shouldSucceed + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``IWSAM Expression conversion works`` () = + Fsx + """ + open Types + + let inline f_IwsamWithExpression<'T when IDelegateConversion<'T>>() = + 'T.ExpressionConversion(fun x -> x + 1) + + if not (f_IwsamWithExpression().Value = 4) then + failwith "Unexpected result" + + """ + |> setupCompilation + |> compileAndRun + |> shouldSucceed + + [] + let ``SRTP Byref can be passed with old syntax`` () = + Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = + let mutable result = 0 + (^T : ( static member TryParse: x: string * byref -> bool) (\"42\", &result))" + |> compile + |> shouldSucceed + + [] + let ``SRTP Byref can be passed with new syntax`` () = + Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = + let mutable result = 0 + 'T.TryParse(\"42\", &result)" + |> compile + |> shouldSucceed + + +module ``SRTP byref tests`` = + + [] + let ``Call with old syntax`` () = + Fsx """ + type C1() = + static member X(p: C1 byref) = p + + let inline callX<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = (^T: (static member X : 'T byref -> 'T) (&x)) + + let mutable c1 = C1() + let g1 = callX &c1 + + if g1 <> c1 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Call with new syntax`` () = + Fsx """ + type C2() = + static member X(p: C2 byref) = p + + let inline callX2<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = 'T.X &x + let mutable c2 = C2() + let g2 = callX2 &c2 + + if g2 <> c2 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Call with tuple`` () = + Fsx """ + + type C3() = + static member X(p: C3 byref, n: int) = p + + let inline callX3<'T when 'T : (static member X: 'T byref * int -> 'T)> (x: 'T byref) = 'T.X (&x, 3) + let mutable c3 = C3() + let g3 = callX3 &c3 + + if g3 <> c3 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let test4 () = + Fsx """ + type C4() = + static member X() = C4() + + let inline callX4<'T when 'T : (static member X: unit -> 'T)> () = 'T.X () + let g4 = callX4 () + + if g4.GetType() <> typeof then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + // NOTE: Trait constraints that involve byref returns currently can never be satisfied by any method. No other warning is given. + // This is a bug that may be fixed in the future. + // These tests are pinning down current behavior. + [] + let ``Byref returns not allowed`` () = + Fsx """ + type C5() = + static member X(p: C5 byref) = &p + + let inline callX5<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = 'T.X &x + let mutable c5 = C5() + let g5 () = callX5 &c5 + """ + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'byref'\\s+but here has type\\s+'C5'" + + [] + let ``Byref returns not allowed pt. 2`` () = + Fsx """ + type C6() = + static member X(p: C6 byref) = &p + + // NOTE: you can declare trait call which returns the address of the thing provided, you just can't satisfy the constraint + let inline callX6<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = &'T.X &x + let mutable c6 = C6() + let g6 () = callX6 &c6 + """ + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'byref'\\s+but here has type\\s+'C6'" + + +module ``Implicit conversion`` = + + let library = + FSharp + """ + module Lib + + type ICanBeInt<'T when 'T :> ICanBeInt<'T>> = + static abstract op_Implicit: 'T -> int + + type C(c: int) = + member _.Value = c + + interface ICanBeInt with + static member op_Implicit(x) = x.Value + + static member TakeInt(x: int) = x + + let add1 (x: int) = x + 1 + """ + |> withLangVersionPreview + |> withOptions ["--nowarn:3535"] + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Function implicit conversion not supported on constrained type`` () = + Fsx + """ + open Lib + let f_function_implicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + add1(a) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Method implicit conversion not supported on constrained type`` () = + Fsx + """ + open Lib + let f_method_implicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + C.TakeInt(a) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Function explicit conversion works on constrained type`` () = + Fsx + """ + open Lib + let f_function_explicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + add1(int(a)) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldSucceed + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Method explicit conversion works on constrained type`` () = + Fsx + """ + open Lib + let f_method_explicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + C.TakeInt(int(a)) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldSucceed + + +module ``Nominal type after or`` = + + [] + let ``Nominal type can be used after or`` () = + Fsx + """ + type C() = + static member X(n, c) = $"{n} OK" + + let inline callX (x: 'T) (y: C) = ((^T or C): (static member X : 'T * C -> string) (x, y));; + + if not (callX 1 (C()) = "1 OK") then + failwith "Unexpected result" + + if not (callX "A" (C()) = "A OK") then + failwith "Unexpected result" + """ + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed + + [] + let ``Nominal type can't be used before or`` () = + Fsx + """ + type C() = + static member X(n, c) = $"{n} OK" + + let inline callX (x: 'T) (y: C) = ((C or ^T): (static member X : 'T * C -> string) (x, y));; + """ + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "Unexpected keyword 'static' in binding" + + [] + let ``Nominal type is preferred`` () = + Fsx + """ + type C() = + static member X(a, b) = "C" + + type D() = + static member X(d: D, a) = "D" + + let inline callX (x: 'T) (y: C) = ((^T or C): (static member X : 'T * C -> string) (x, y));; + + if not (callX (D()) (C()) = "C") then + failwith "Unexpected result" + + let inline callX2 (x: C) (y: 'T) = ((^T or C): (static member X : 'T * C -> string) (y, x));; + + if not (callX2 (C()) (D()) = "C") then + failwith "Unexpected result" + """ + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed + +module ``Active patterns`` = + + let library = + FSharp """ + module Potato.Lib + type IPotato<'T when 'T :> IPotato<'T>> = + static abstract member IsGood: 'T -> bool + static abstract member op_Equality: 'T * 'T -> bool + + type Potato() = + interface IPotato with + static member IsGood c = true + static member op_Equality (a, b) = false + + type Rock() = + interface IPotato with + static member IsGood c = false + static member op_Equality (a, b) = false + """ + |> withLangVersionPreview + |> withName "Potato" + |> withOptions ["--nowarn:3535"] + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Using IWSAM in active pattern`` () = + FSharp """ + module Potato.Test + + open Lib + + let (|GoodPotato|_|) (x : 'T when 'T :> IPotato<'T>) = if 'T.IsGood x then Some () else None + + match Potato() with GoodPotato -> () | _ -> failwith "Unexpected result" + match Rock() with GoodPotato -> failwith "Unexpected result" | _ -> () + """ + |> withReferences [library] + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + |> verifyIL [ + """ + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1 + '|GoodPotato|_|'<(class [Potato]Potato.Lib/IPotato`1) T>(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: constrained. !!T + IL_0007: call bool class [Potato]Potato.Lib/IPotato`1::IsGood(!0) + IL_000c: brfalse.s IL_0015 + """ + ] + + #if !NETCOREAPP + [] + #else + [] + #endif + let ``Using IWSAM equality in active pattern uses generic equality intrinsic`` () = + FSharp """ + module Potato.Test + + open Lib + + let (|IsEqual|IsNonEqual|) (x: 'T when IPotato<'T>, y: 'T when IPotato<'T>) = + match x with + | x when x = y -> IsEqual + | _ -> IsNonEqual + + match Potato(), Potato() with + | IsEqual -> failwith "Unexpected result" + | IsNonEqual -> () + """ + |> withReferences [library] + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed + |> verifyIL [ + """ + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 + '|IsEqual|IsNonEqual|'<(class [Potato]Potato.Lib/IPotato`1) T>(!!T x, + !!T y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, + + """ + ] + +module ``Suppression of System Numerics interfaces on unitized types`` = + + [] + let Baseline () = + Fsx """ + open System.Numerics + let f (x: 'T when 'T :> IMultiplyOperators<'T,'T,'T>) = x;; + f 3.0 |> ignore""" + |> withLangVersionPreview + |> compile + |> shouldSucceed + + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + let ``Unitized type shouldn't be compatible with System.Numerics.I*`` name paramCount = + let typeParams = Seq.replicate paramCount "'T" |> String.concat "," + let genericType = $"{name}<{typeParams}>" + let potatoParams = Seq.replicate paramCount "float" |> String.concat "," + let potatoType = $"{name}<{potatoParams}>" + Fsx $""" + open System.Numerics + + [] type potato + + let f (x: 'T when {genericType}) = x;; + f 3.0 |> ignore""" + |> withLangVersionPreview + |> compile + |> shouldFail + |> withErrorMessage $"The type 'float' is not compatible with the type '{potatoType}'" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs new file mode 100644 index 00000000000..d8c98028621 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs @@ -0,0 +1,39 @@ +module Types + +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = + static abstract StaticMethod: 'T -> 'T + +type IUnitMethod<'T when 'T :> IUnitMethod<'T>> = + static abstract UnitMethod: unit -> unit + +type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = + static abstract op_Addition: 'T * 'T -> 'T + +type ISinOperator<'T when 'T :> ISinOperator<'T>> = + static abstract Sin: 'T -> 'T + +type IDelegateConversion<'T when 'T :> IDelegateConversion<'T>> = + static abstract FuncConversion: System.Func -> 'T + static abstract ExpressionConversion: System.Linq.Expressions.Expression> -> 'T + +type C(c: int) = + member _.Value = c + + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + + interface IStaticProperty with + static member StaticProperty = C(7) + + interface IStaticMethod with + static member StaticMethod(x) = C(x.Value + 4) + + interface IUnitMethod with + static member UnitMethod() = () + + interface IDelegateConversion with + static member FuncConversion(f) = C(f.Invoke(3)) + static member ExpressionConversion(e) = C(e.Compile().Invoke(3)) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/BasicTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/BasicTests.fs new file mode 100644 index 00000000000..420b85ab2f5 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/BasicTests.fs @@ -0,0 +1,61 @@ +open Types + +module ``Test basic IWSAM generic code`` = + + let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + + let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + + let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + + let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = + 'T.UnitMethod() + + let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + + let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty + + let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = + 'T.StaticMethod(x) + + + let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.(+)(x,y) + + let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + x + y + + let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + + let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + + let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + + + module CheckExecution = + if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_StaticProperty().Value <> 7 then + failwith "incorrect value" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs new file mode 100644 index 00000000000..f9a593a5cf2 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs @@ -0,0 +1,60 @@ +open Types + +module CheckNewSyntax = + + type MyType() = + static member val StaticProperty = 0 with get, set + static member StaticMethod x = x + 5 + member val Length = 0 with get, set + member _.Item with get x = "Hello" + member _.InstanceMethod x = x + 5 + + // Check that "property" and "get_ method" constraints are considered logically equivalent + let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty + + let inline f_StaticMethod<'T when 'T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) + + let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) + + let inline f_InstanceMethod<'T when 'T : (member InstanceMethod: int -> int) >(x: 'T) : int = x.InstanceMethod(3) + + let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length + + let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = x.set_Length(3) + + let inline f_Item<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) + + // Limitation by-design: As yet the syntax "'T.StaticProperty <- 3" can't be used + // Limitation by-design: As yet the syntax "x.Length <- 3" can't be used + // Limitation by-design: As yet the syntax "x[3]" can't be used, nor can any slicing syntax + // Limitation by-design: The disposal pattern can't be used with "use" + + //let inline f_set_StaticProperty2<'T when 'T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 + //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 + //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3] + + if f_StaticMethod() <> 8 then + failwith "Unexpected result" + + if f_set_StaticProperty() <> () then + failwith "Unexpected result" + + if f_StaticProperty() <> 3 then + failwith "Unexpected result" + + let myInstance = MyType() + + if f_Length(myInstance) <> 0 then + failwith "Unexpected result" + + if f_InstanceMethod(myInstance) <> 8 then + failwith "Unexpected result" + + if f_set_Length(myInstance) <> () then + failwith "Unexpected result" + + if f_Length(myInstance) <> 3 then + failwith "Unexpected result" + + if f_Item(myInstance) <> "Hello" then + failwith "Unexpected result" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedIWSAM.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedIWSAM.fs new file mode 100644 index 00000000000..3755c6bfc86 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedIWSAM.fs @@ -0,0 +1,51 @@ +open System +open Types + +module CheckSelfConstrainedIWSAM = + + let f_IWSAM_explicit_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + let f_IWSAM_pretty_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + + let f_IWSAM_StaticProperty<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + + let f_IWSAM_declared_StaticMethod<'T when IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + + let f_IWSAM_declared_UnitMethod<'T when IUnitMethod<'T>>() = + 'T.UnitMethod() + + let f_IWSAM_declared_UnitMethod_list<'T when IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + + let inline f3<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T + type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T + type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T + + let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty + let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) + let inline f_Both<'T when WithBoth<'T> >() = + let v1 = 'T.StaticProperty + let v2 = 'T.StaticMethod(3) + v1 + v2 + + let inline f_OK1<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) |> ignore + 'T.StaticMethod(3) + + let inline f_OK2<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) |> ignore + 'T.StaticMethod(3) + + let inline f_OK3<'T when WithBoth<'T>>() = + printfn "" + 'T.StaticMethod(3) + + printfn "" \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedSRTP.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedSRTP.fs new file mode 100644 index 00000000000..c96e1481cdc --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedSRTP.fs @@ -0,0 +1,18 @@ +open Types + +module CheckSelfConstrainedSRTP = + + let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + + type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + + let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = + let mutable sum = 'T.Zero + for x in xs do + sum <- sum + x + 'T.DivideByInt(sum, xs.Length) + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs new file mode 100644 index 00000000000..b7080061a72 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs @@ -0,0 +1,17 @@ +#nowarn "62" + +module TestLegacyThingsThatRegressedDuringRFC = + let legacyConcat1 (x: string) (y: string) = x ^ y + let legacyConcat2 (x: string) (y: string) = x ^y + let legacyConcat3 (x: string) (y: string) = x^ y + let legacyConcat4 (x: string) (y: string) = x^y + + let testSlicingOne() = + let arr = [| 1;2;3;4;5 |] + arr.[^3..] + + let testSlicingTwo() = + let arr = [| 1;2;3;4;5 |] + arr[^3..] + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/UseSRTPFromIWSAMGenericCode.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/UseSRTPFromIWSAMGenericCode.fs new file mode 100644 index 00000000000..de287cbf754 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/UseSRTPFromIWSAMGenericCode.fs @@ -0,0 +1,33 @@ +#nowarn "64" +open Types + +module ``Use SRTP from IWSAM generic code`` = + module ``Use SRTP operators from generic IWSAM code`` = + let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + x + y + + let fSin<'T when ISinOperator<'T>>(x: 'T) = + sin x + + module ``Use SRTP operators from generic IWSAM code not rigid`` = + let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = + x + y + + let fSin(x: 'T when ISinOperator<'T>) = + sin x + + module ``Use SRTP operators from generic IWSAM code flex`` = + let fAdd(x: #IAdditionOperator<'T>, y) = + x + y + + let fSin(x: #ISinOperator<'T>) = + sin x + + module ``Use SRTP operators from generic IWSAM code super flex`` = + let fAdd(x: #IAdditionOperator<_>, y) = + x + y + + let fSin(x: #ISinOperator<_>) = + sin x + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 9c6e84e4a0c..5935d322ccf 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -15,6 +15,7 @@ false $(OtherFlags) --warnon:1182 $(NoWarn);FS0988 + true @@ -83,6 +84,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index ebbcc958077..2b7f9e8c87a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -20,6 +20,12 @@ module ``Static Methods In Interfaces`` = { static abstract T Next(T other); } + + public interface IGetNext2 where T : IGetNext2 + { + abstract T Next(T other); + } + public record RepeatSequence : IGetNext { private const char Ch = 'A'; @@ -33,6 +39,78 @@ module ``Static Methods In Interfaces`` = }""" |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csLib" + let csharpOperators = + CSharp """ + namespace StaticsInInterfaces + { + public interface IAddable where T : IAddable + { + static abstract T operator +(T left, T right); + } + + + public record MyInteger : IAddable + { + public int Value { get; init; } = default; + public MyInteger(int value) + { + Value = value; + } + + public static MyInteger operator +(MyInteger left, MyInteger right) => new MyInteger(left.Value + right.Value); + } + + } + """ |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csOpLib" + + #if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can use operators declared in C#`` () = + + let fsharpSource = + """ +open System +open StaticsInInterfaces + +type MyInteger2 = + val Value : int + new(value: int) = { Value = value } + static member op_Addition(left: MyInteger2, right: MyInteger2) : MyInteger2 = MyInteger2(left.Value + right.Value) + interface IAddable with + static member op_Addition(left: MyInteger2, right: MyInteger2) : MyInteger2 = MyInteger2.op_Addition(left, right) + +[] +let main _ = + let mint1 = new MyInteger(1) + let mint2 = new MyInteger(2) + + let sum = mint1 + mint2 + + let mint21 = new MyInteger2(2) + let mint22 = new MyInteger2(4) + + let sum2 = mint21 + mint22 + + if sum.Value <> 3 then + failwith $"Unexpected result: %d{sum.Value}" + + if sum2.Value <> 6 then + failwith $"Unexpected result: %d{sum2.Value}" + + // TODO: Figure out if we allow something like: + // let add (a: IAddable<_>) (b: IAddable<_>) = a + b + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> withReferences [csharpOperators] + |> compileAndRun + |> shouldSucceed + #if !NETCOREAPP [] #else @@ -68,4 +146,431 @@ let main _ = |> withReferences [csharpLib] |> compileAndRun |> shouldSucceed - // TODO: test operators, test implementing statics. \ No newline at end of file + + + (* For reference: + Roslyn generates the following interface: + .class interface public auto ansi abstract IGetNext`1<(class IGetNext`1) T> + { + // Methods + .method public hidebysig abstract virtual static + !T Next ( + !T other + ) cil managed + { + } // end of method IGetNext`1::Next + + } // end of class IGetNext`1 + + And the following implementation: + .method public hidebysig static + class RepeatSequence Next (class RepeatSequence other) cil managed + { + .override method !0 class IGetNext`1::Next(!0) + ... + } + *) + #if !NETCOREAPP + [] + #else + [] + #endif + let ``F# generates valid IL for abstract static interface methods`` () = + + let csharpLib = csharpBaseClass + + let fsharpSource = + """ +module StaticsTesting +open StaticsInInterfaces + +type MyRepeatSequence() = + interface IGetNext with + static member Next(other: MyRepeatSequence) : MyRepeatSequence = other + +type MyRepeatSequence2() = + static member Next(other: MyRepeatSequence2) = other + interface IGetNext with + static member Next(other: MyRepeatSequence2) : MyRepeatSequence2 = MyRepeatSequence2.Next(other) +""" + Fsx fsharpSource + |> withLangVersionPreview + |> withReferences [csharpLib] + |> compile + |> shouldSucceed + |> verifyIL [ + """ +.class auto ansi serializable nested public MyRepeatSequence +extends [runtime]System.Object +implements class [csLib]StaticsInInterfaces.IGetNext`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public specialname rtspecialname +instance void .ctor() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret + } + + .method public hidebysig static class StaticsTesting/MyRepeatSequence +'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed + { + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } + + } + + .class auto ansi serializable nested public MyRepeatSequence2 +extends [runtime]System.Object +implements class [csLib]StaticsInInterfaces.IGetNext`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public specialname rtspecialname +instance void .ctor() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret + } + + .method public static class StaticsTesting/MyRepeatSequence2 +Next(class StaticsTesting/MyRepeatSequence2 other) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } + + .method public hidebysig static class StaticsTesting/MyRepeatSequence2 +'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence2 other) cil managed + { + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } + + } + """] + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can implement static methods declared in interfaces from C#`` () = + + let csharpLib = csharpBaseClass + + let fsharpSource = + """ +open System +open StaticsInInterfaces + +type MyRepeatSequence() = + [] val mutable Text : string + + override this.ToString() = this.Text + + static member Next(other: MyRepeatSequence) = + other.Text <- other.Text + "A" + other + + interface IGetNext with + static member Next(other: MyRepeatSequence) : MyRepeatSequence = MyRepeatSequence.Next(other) + +[] +let main _ = + + let mutable str = MyRepeatSequence () + str.Text <- "A" + let res = [ for i in 0..10 do + yield str.ToString() + str <- MyRepeatSequence.Next(str) ] + + if res <> ["A"; "AA"; "AAA"; "AAAA"; "AAAAA"; "AAAAAA"; "AAAAAAA"; "AAAAAAAA"; "AAAAAAAAA"; "AAAAAAAAAA"; "AAAAAAAAAAA"] then + failwith $"Unexpected result: %A{res}" + + if string(str) <> "AAAAAAAAAAAA" then + failwith $"Unexpected result %s{string(str)}" + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> withReferences [csharpLib] + |> compileAndRun + |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can implement interfaces with static abstract methods`` () = + + let fsharpSource = + """ +#nowarn "3535" +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C() = + interface IAdditionOperator with + static member op_Addition(x: C, y: C) = C() + +[] +let main _ = 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# supports inference for types of arguments when implementing interfaces`` () = + + let fsharpSource = + """ +#nowarn "3535" +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C() = + interface IAdditionOperator with + static member op_Addition(x, y) = C() // no type annotation needed on 'x' and 'y' + +[] +let main _ = 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can call interface with static abstract method`` () = + FSharp + """ +#nowarn "3535" +namespace Tests + +[] +do() + +module Test = + + type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + + type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + + let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + [] + let main _ = + if f(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + 0 +""" + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + |> verifyIL [ + """ +.class public abstract auto ansi sealed Tests.Test + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class interface abstract auto ansi serializable nested public IAdditionOperator`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public hidebysig static abstract virtual + !T op_Addition(!T A_0, + !T A_1) cil managed + { + } + + } + + .class auto ansi serializable nested public C + extends [runtime]System.Object + implements class Tests.Test/IAdditionOperator`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly int32 c + .method public specialname rtspecialname + instance void .ctor(int32 c) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ldarg.0 + IL_0009: ldarg.1 + IL_000a: stfld int32 Tests.Test/C::c + IL_000f: ret + } + + .method public hidebysig specialname + instance int32 get_Value() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 Tests.Test/C::c + IL_0006: ret + } + + .method public hidebysig static class Tests.Test/C + 'Tests.Test.IAdditionOperator.op_Addition'(class Tests.Test/C x, + class Tests.Test/C y) cil managed + { + .override method !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 Tests.Test/C::c + IL_0006: ldarg.1 + IL_0007: ldfld int32 Tests.Test/C::c + IL_000c: add + IL_000d: newobj instance void Tests.Test/C::.ctor(int32) + IL_0012: ret + } + + .property instance int32 Value() + { + .get instance int32 Tests.Test/C::get_Value() + } + } + + .method public static !!T f<(class Tests.Test/IAdditionOperator`1) T>(!!T x, + !!T y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: constrained. !!T + IL_0008: call !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + IL_000d: ret + } + + .method public static int32 main(string[] _arg1) cil managed + { + .entrypoint + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.EntryPointAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (class Tests.Test/C V_0, + class Tests.Test/C V_1) + IL_0000: ldc.i4.3 + IL_0001: newobj instance void Tests.Test/C::.ctor(int32) + IL_0006: stloc.0 + IL_0007: ldc.i4.4 + IL_0008: newobj instance void Tests.Test/C::.ctor(int32) + IL_000d: stloc.1 + IL_000e: ldloc.0 + IL_000f: ldloc.1 + IL_0010: constrained. Tests.Test/C + IL_0016: call !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + IL_001b: ldfld int32 Tests.Test/C::c + IL_0020: ldc.i4.7 + IL_0021: beq.s IL_002e + + IL_0023: ldstr "incorrect value" + IL_0028: newobj instance void [netstandard]System.Exception::.ctor(string) + IL_002d: throw + + IL_002e: ldc.i4.0 + IL_002f: ret + } + +} + """ ] + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``C# can call constrained method defined in F#`` () = + let FSharpLib = + FSharp """ + namespace MyNamespace + + type IFoo<'T> = + static abstract Foo: 'T * 'T -> 'T + + module Stuff = + let F<'T when 'T :> IFoo<'T>>(x: 'T, y: 'T) = + 'T.Foo(x, y) + """ + |> withLangVersionPreview + |> withName "FsLibAssembly" + |> withOptions ["--nowarn:3535"] + + CSharp """ + namespace MyNamespace { + + class Potato : IFoo + { + public Potato(int x) => this.x = x; + + public int x; + + public static Potato Foo(Potato x, Potato y) => new Potato(x.x + y.x); + + public static void Main(string[] args) + { + var x = new Potato(4); + var y = new Potato(9); + var z = Stuff.F(x, y); + if (z.x != 13) + { + throw new System.Exception("incorrect value"); + } + } + } + } + """ + |> withReferences [FSharpLib] + |> withCSharpLanguageVersion CSharpLanguageVersion.Preview + |> withName "CsProgram" + |> compileExeAndRun + |> shouldSucceed diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 2fad3357478..c9f58e3ca78 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -6709,6 +6709,7 @@ FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Sequential FSharp.Compiler.Syntax.SynExpr+Tags: Int32 SequentialOrImplicitYield FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Set FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TraitCall +FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Typar FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TryFinally FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TryWith FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Tuple @@ -6725,8 +6726,8 @@ FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Syntax.SynMemberSig ge FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Syntax.SynMemberSig traitSig FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar] get_supportTys() -FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar] supportTys +FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType] get_supportTys() +FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType] supportTys FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtFinally finallyDebugPoint FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtFinally get_finallyDebugPoint() FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtTry get_tryDebugPoint() @@ -6759,6 +6760,10 @@ FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[ FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr] get_exprs() FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range] commaRanges FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range] get_commaRanges() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Syntax.SynTypar get_typar() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Syntax.SynTypar typar +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Syntax.SynExpr get_expr() FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Text.Range get_lessRange() @@ -6869,6 +6874,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean IsSequential FSharp.Compiler.Syntax.SynExpr: Boolean IsSequentialOrImplicitYield FSharp.Compiler.Syntax.SynExpr: Boolean IsSet FSharp.Compiler.Syntax.SynExpr: Boolean IsTraitCall +FSharp.Compiler.Syntax.SynExpr: Boolean IsTypar FSharp.Compiler.Syntax.SynExpr: Boolean IsTryFinally FSharp.Compiler.Syntax.SynExpr: Boolean IsTryWith FSharp.Compiler.Syntax.SynExpr: Boolean IsTuple @@ -6940,6 +6946,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTraitCall() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTryFinally() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTryWith() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTuple() +FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypar() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypeApp() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypeTest() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTyped() @@ -7003,7 +7010,8 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewRecord(Microso FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequential(FSharp.Compiler.Syntax.DebugPointAtSequential, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequentialOrImplicitYield(FSharp.Compiler.Syntax.DebugPointAtSequential, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypar(FSharp.Compiler.Syntax.SynTypar, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryFinally(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtFinally, FSharp.Compiler.SyntaxTrivia.SynExprTryFinallyTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryWith(FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtWith, FSharp.Compiler.SyntaxTrivia.SynExprTryWithTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTuple(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) @@ -7075,6 +7083,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TraitCall FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TryFinally FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TryWith FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Tuple +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Typar FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TypeApp FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TypeTest FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Typed @@ -7339,6 +7348,10 @@ FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.Ident FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.Ident ident FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynExpr get_synExpr() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynExpr synExpr +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags get_memberFlags() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags get_memberFlagsForSet() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags memberFlags +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags memberFlagsForSet FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberKind get_propKind() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberKind propKind FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Text.Range equalsRange @@ -7349,8 +7362,6 @@ FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Xml.PreXmlDoc FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Xml.PreXmlDoc xmlDoc FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList] attributes FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList] get_attributes() -FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags] get_memberFlags() -FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags] memberFlags FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] accessibility FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] get_accessibility() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType] get_typeOpt() @@ -7464,7 +7475,7 @@ FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsNestedType() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsOpen() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsValField() FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAbstractSlot(FSharp.Compiler.Syntax.SynValSig, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags], FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewGetSetMember(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynBinding], FSharp.Compiler.Text.Range, FSharp.Compiler.SyntaxTrivia.SynMemberGetSetTrivia) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitCtor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynSimplePats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitInherit(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) @@ -8600,6 +8611,7 @@ FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsDelegate FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsEnum FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsEquatable FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsReferenceType +FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereSelfConstrained FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsUnmanaged FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsValueType FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparSubtypeOfType @@ -8659,6 +8671,11 @@ FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Syntax.SynTypar typar FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Syntax.SynType get_selfConstraint() +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Syntax.SynType selfConstraint +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereSelfConstrained FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparDefaultsToType FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparIsComparable FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparIsDelegate @@ -8709,6 +8726,9 @@ FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Text.Range get_Range() FSharp.Compiler.Syntax.SynTypeConstraint: Int32 Tag FSharp.Compiler.Syntax.SynTypeConstraint: Int32 get_Tag() FSharp.Compiler.Syntax.SynTypeConstraint: System.String ToString() +FSharp.Compiler.Syntax.SynTypeConstraint: Boolean get_IsWhereSelfConstrained() +FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Syntax.SynTypeConstraint NewWhereSelfConstrained(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained FSharp.Compiler.Syntax.SynTypeDefn FSharp.Compiler.Syntax.SynTypeDefn: FSharp.Compiler.Syntax.SynComponentInfo get_typeInfo() FSharp.Compiler.Syntax.SynTypeDefn: FSharp.Compiler.Syntax.SynComponentInfo typeInfo diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs index 81919c25ef3..ebf57856db3 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs @@ -92,34 +92,34 @@ module Value = module TaskLowProrityExtensions = type TaskBuilderDynamic with - member inline _.ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.ReturnFrom<^TaskLike, ^Awaiter, ^T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - (t: ^TaskLike) : TaskCode< ^T, ^T> = + and ^Awaiter: (member GetResult: unit -> ^T)> + (t: ^TaskLike) : TaskCode<^T, ^T> = task.ReturnFrom(t) - member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.Bind<^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> + and ^Awaiter: (member GetResult: unit -> ^TResult1)> (t: ^TaskLike, continuation: (^TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> = task.Bind(t, continuation) type BackgroundTaskBuilderDynamic with - member inline _.ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.ReturnFrom<^TaskLike, ^Awaiter, ^T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - (t: ^TaskLike) : TaskCode< ^T, ^T> = + and ^Awaiter: (member GetResult: unit -> ^T)> + (t: ^TaskLike) : TaskCode<^T, ^T> = backgroundTask.ReturnFrom(t) - member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.Bind<^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> + and ^Awaiter: (member GetResult: unit -> ^TResult1)> (t: ^TaskLike, continuation: (^TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> = backgroundTask.Bind(t, continuation) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 574d7dae1ee..020ebe9363c 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -85,6 +85,7 @@ module rec Compiler = Source: SourceCodeFileKind LangVersion: CSharpLanguageVersion TargetFramework: TargetFramework + OutputType: CompileOutput OutputDirectory: DirectoryInfo option Name: string option References: CompilationUnit list @@ -137,7 +138,7 @@ module rec Compiler = type Disposable (dispose : unit -> unit) = interface IDisposable with - member this.Dispose() = + member this.Dispose() = dispose() type ErrorInfo = @@ -145,15 +146,13 @@ module rec Compiler = Range: Range Message: string } - type EvalOutput = Result - type ExecutionOutput = { ExitCode: int StdOut: string StdErr: string } type RunOutput = - | EvalOutput of EvalOutput + | EvalOutput of Result | ExecutionOutput of ExecutionOutput type CompilationOutput = @@ -168,6 +167,9 @@ module rec Compiler = type CompilationResult = | Success of CompilationOutput | Failure of CompilationOutput + with + member this.Output = match this with Success o | Failure o -> o + member this.RunOutput = this.Output.Output type ExecutionPlatform = | Anycpu = 0 @@ -209,7 +211,8 @@ module rec Compiler = Source = source LangVersion = CSharpLanguageVersion.CSharp9 TargetFramework = TargetFramework.Current - OutputDirectory= None + OutputType = Library + OutputDirectory = None Name = None References = [] } @@ -464,12 +467,13 @@ module rec Compiler = let asExe (cUnit: CompilationUnit) : CompilationUnit = match cUnit with - | FS fs -> FS { fs with OutputType = CompileOutput.Exe } + | FS x -> FS { x with OutputType = Exe } + | CS x -> CS { x with OutputType = Exe } | _ -> failwith "TODO: Implement where applicable." let withPlatform (platform:ExecutionPlatform) (cUnit: CompilationUnit) : CompilationUnit = match cUnit with - | FS _ -> + | FS _ -> let p = match platform with | ExecutionPlatform.Anycpu -> "anycpu" @@ -569,22 +573,37 @@ module rec Compiler = let compilation = Compilation.CreateFromSources([fs.Source] @ fs.AdditionalSources, output, options, references, name, outputDirectory) compileFSharpCompilation compilation fs.IgnoreWarnings (FS fs) - let private compileCSharpCompilation (compilation: CSharpCompilation) csSource : CompilationResult = - let outputPath = tryCreateTemporaryDirectory() - Directory.CreateDirectory(outputPath) |> ignore - let fileName = compilation.AssemblyName - let output = Path.Combine(outputPath, Path.ChangeExtension(fileName, ".dll")) - let cmplResult = compilation.Emit (output) + let toErrorInfo (d: Diagnostic) = + let span = d.Location.GetMappedLineSpan().Span + let number = d.Id |> Seq.where Char.IsDigit |> String.Concat |> int + + { Error = + match d.Severity with + | DiagnosticSeverity.Error -> Error + | DiagnosticSeverity.Warning -> Warning + | DiagnosticSeverity.Info -> Information + | DiagnosticSeverity.Hidden -> Hidden + | x -> failwith $"Unknown severity {x}" + |> (|>) number + Range = + { StartLine = span.Start.Line + StartColumn = span.Start.Character + EndLine = span.End.Line + EndColumn = span.End.Character } + Message = d.GetMessage() } + + let private compileCSharpCompilation (compilation: CSharpCompilation) csSource (filePath : string) dependencies : CompilationResult = + let cmplResult = compilation.Emit filePath let result = { OutputPath = None - Dependencies = [] + Dependencies = dependencies Adjust = 0 - Diagnostics = [] - Output = None + Diagnostics = cmplResult.Diagnostics |> Seq.map toErrorInfo |> Seq.toList + Output = None Compilation = CS csSource } if cmplResult.Success then - CompilationResult.Success { result with OutputPath = Some output } + CompilationResult.Success { result with OutputPath = Some filePath } else CompilationResult.Failure result @@ -599,9 +618,12 @@ module rec Compiler = | None -> DirectoryInfo(tryCreateTemporaryDirectory()) let additionalReferences = - match processReferences csSource.References outputDirectory with - | [] -> ImmutableArray.Empty - | r -> (List.map (asMetadataReference (CS csSource)) r).ToImmutableArray().As() + processReferences csSource.References outputDirectory + |> List.map (asMetadataReference (CS csSource)) + + let additionalMetadataReferences = additionalReferences.ToImmutableArray().As() + + let additionalReferencePaths = [for r in additionalReferences -> r.FilePath] let references = TargetFrameworkUtil.getReferences csSource.TargetFramework @@ -612,14 +634,22 @@ module rec Compiler = | CSharpLanguageVersion.Preview -> LanguageVersion.Preview | _ -> LanguageVersion.Default + let outputKind, extension = + match csSource.OutputType with + | Exe -> OutputKind.ConsoleApplication, "exe" + | Library -> OutputKind.DynamicallyLinkedLibrary, "dll" + let cmpl = CSharpCompilation.Create( name, [ CSharpSyntaxTree.ParseText (source, CSharpParseOptions lv) ], - references.As().AddRange additionalReferences, - CSharpCompilationOptions (OutputKind.DynamicallyLinkedLibrary)) + references.As().AddRange additionalMetadataReferences, + CSharpCompilationOptions outputKind) + + let filename = Path.ChangeExtension(cmpl.AssemblyName, extension) + let filePath = Path.Combine(outputDirectory.FullName, filename) - compileCSharpCompilation cmpl csSource + compileCSharpCompilation cmpl csSource filePath additionalReferencePaths let compile (cUnit: CompilationUnit) : CompilationResult = match cUnit with @@ -669,7 +699,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = None + Output = None Compilation = FS fsSource } if failed then @@ -699,7 +729,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = None + Output = None Compilation = FS fsSource } let (errors, warnings) = partitionErrors diagnostics @@ -752,18 +782,18 @@ module rec Compiler = let options = fs.Options |> Array.ofList use script = new FSharpScript(additionalArgs=options) - let ((evalresult: Result), (err: FSharpDiagnostic[])) = script.Eval(source) + let (evalResult: Result), (err: FSharpDiagnostic[]) = script.Eval(source) let diagnostics = err |> fromFSharpDiagnostic let result = { OutputPath = None Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = Some(EvalOutput evalresult) + Output = Some (EvalOutput evalResult) Compilation = FS fs } let (errors, warnings) = partitionErrors diagnostics - let evalError = match evalresult with Ok _ -> false | _ -> true + let evalError = match evalResult with Ok _ -> false | _ -> true if evalError || errors.Length > 0 || (warnings.Length > 0 && not fs.IgnoreWarnings) then CompilationResult.Failure result else @@ -812,7 +842,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = [] - Output = None + Output = None Compilation = cUnit } if errors.Count > 0 then @@ -971,19 +1001,19 @@ module rec Compiler = let private verifySequencePoints (reader: MetadataReader) expectedSequencePoints = - let sequencePoints = + let sequencePoints = [ for sp in reader.MethodDebugInformation do let mdi = reader.GetMethodDebugInformation sp yield! mdi.GetSequencePoints() ] |> List.sortBy (fun sp -> sp.StartLine) |> List.map (fun sp -> (Line sp.StartLine, Col sp.StartColumn, Line sp.EndLine, Col sp.EndColumn) ) - + if sequencePoints <> expectedSequencePoints then failwith $"Expected sequence points are different from PDB.\nExpected: %A{expectedSequencePoints}\nActual: %A{sequencePoints}" let private verifyDocuments (reader: MetadataReader) expectedDocuments = - let documents = + let documents = [ for doc in reader.Documents do if not doc.IsNil then let di = reader.GetDocument doc @@ -992,7 +1022,7 @@ module rec Compiler = let name = reader.GetString nmh name ] |> List.sort - + let expectedDocuments = expectedDocuments |> List.sort if documents <> expectedDocuments then @@ -1102,7 +1132,7 @@ module rec Compiler = match result with | CompilationResult.Success _ -> result | CompilationResult.Failure r -> - let message = + let message = [ sprintf "Operation failed (expected to succeed).\n All errors:\n%A\n" r.Diagnostics match r.Output with | Some (ExecutionOutput output) -> @@ -1113,12 +1143,12 @@ module rec Compiler = let shouldFail (result: CompilationResult) : CompilationResult = match result with - | CompilationResult.Success _ -> failwith "Operation was succeeded (expected to fail)." + | CompilationResult.Success _ -> failwith "Operation succeeded (expected to fail)." | CompilationResult.Failure _ -> result let private assertResultsCategory (what: string) (selector: CompilationOutput -> ErrorInfo list) (expected: ErrorInfo list) (result: CompilationResult) : CompilationResult = match result with - | CompilationResult.Success r + | CompilationResult.Success r | CompilationResult.Failure r -> assertErrors what r.Adjust (selector r) expected result @@ -1187,6 +1217,12 @@ module rec Compiler = let private diagnosticMatches (pattern: string) (diagnostics: ErrorInfo list) : bool = diagnostics |> List.exists (fun d -> Regex.IsMatch(d.Message, pattern)) + let withDiagnosticMessage (message: string) (result: CompilationResult) : CompilationResult = + let messages = [for d in result.Output.Diagnostics -> d.Message] + if not (messages |> List.exists ((=) message)) then + failwith $"Message:\n{message}\n\nwas not found. All diagnostic messages:\n{messages}" + result + let withDiagnosticMessageMatches (pattern: string) (result: CompilationResult) : CompilationResult = match result with | CompilationResult.Success r @@ -1222,30 +1258,24 @@ module rec Compiler = withWarningMessages [message] result let withExitCode (expectedExitCode: int) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith "Execution output is missing, cannot check exit code." - | Some o -> - match o with - | ExecutionOutput e -> Assert.AreEqual(e.ExitCode, expectedExitCode, sprintf "Exit code was expected to be: %A, but got %A." expectedExitCode e.ExitCode) - | _ -> failwith "Cannot check exit code on this run result." + match result.RunOutput with + | None -> failwith "Execution output is missing, cannot check exit code." + | Some o -> + match o with + | ExecutionOutput e -> Assert.AreEqual(e.ExitCode, expectedExitCode, sprintf "Exit code was expected to be: %A, but got %A." expectedExitCode e.ExitCode) + | _ -> failwith "Cannot check exit code on this run result." result let private checkOutput (category: string) (substring: string) (selector: ExecutionOutput -> string) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) - | Some o -> - match o with - | ExecutionOutput e -> - let where = selector e - if not (where.Contains(substring)) then - failwith (sprintf "\nThe following substring:\n %A\nwas not found in the %A\nOutput:\n %A" substring category where) - | _ -> failwith "Cannot check output on this run result." + match result.RunOutput with + | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) + | Some o -> + match o with + | ExecutionOutput e -> + let where = selector e + if not (where.Contains(substring)) then + failwith (sprintf "\nThe following substring:\n %A\nwas not found in the %A\nOutput:\n %A" substring category where) + | _ -> failwith "Cannot check output on this run result." result let withOutputContains (substring: string) (result: CompilationResult) : CompilationResult = @@ -1257,23 +1287,13 @@ module rec Compiler = let withStdErrContains (substring: string) (result: CompilationResult) : CompilationResult = checkOutput "STDERR" substring (fun o -> o.StdErr) result - // TODO: probably needs a bit of simplification, + need to remove that pyramid of doom. let private assertEvalOutput (selector: FsiValue -> 'T) (value: 'T) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith "Execution output is missing cannot check value." - | Some o -> - match o with - | EvalOutput e -> - match e with - | Ok v -> - match v with - | None -> failwith "Cannot assert value of evaluation, since it is None." - | Some e -> Assert.AreEqual(value, (selector e)) - | Result.Error ex -> raise ex - | _ -> failwith "Only 'eval' output is supported." + match result.RunOutput with + | None -> failwith "Execution output is missing cannot check value." + | Some (EvalOutput (Ok (Some e))) -> Assert.AreEqual(value, (selector e)) + | Some (EvalOutput (Ok None )) -> failwith "Cannot assert value of evaluation, since it is None." + | Some (EvalOutput (Result.Error ex)) -> raise ex + | Some _ -> failwith "Only 'eval' output is supported." result // TODO: Need to support for: @@ -1285,3 +1305,21 @@ module rec Compiler = let withEvalTypeEquals t (result: CompilationResult) : CompilationResult = assertEvalOutput (fun (x: FsiValue) -> x.ReflectionType) t result + + let signatureText (checkResults: FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults) = + checkResults.GenerateSignature() + |> Option.defaultWith (fun _ -> failwith "Unable to generate signature text.") + + let signaturesShouldContain (expected: string) cUnit = + let text = + cUnit + |> typecheckResults + |> signatureText + + let actual = + text.ToString().Split('\n') + |> Array.map (fun s -> s.TrimEnd(' ')) + |> Array.filter (fun s -> s.Length > 0) + + if not (actual |> Array.contains expected) then + failwith ($"The following signature:\n%s{expected}\n\nwas not found in:\n" + (actual |> String.concat "\n")) diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 6378786e97d..daab582a61b 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -471,7 +471,7 @@ module rec CompilerAssertHelpers = compilationRefs, deps - let rec compileCompilationAux outputDirectory (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * string) * string list = + let compileCompilationAux outputDirectory (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * string) * string list = let compilationRefs, deps = evaluateReferences outputDirectory disposals ignoreWarnings cmpl let isExe, sources, options, name = @@ -493,7 +493,7 @@ module rec CompilerAssertHelpers = res, (deps @ deps2) - let rec compileCompilation ignoreWarnings (cmpl: Compilation) f = + let compileCompilation ignoreWarnings (cmpl: Compilation) f = let disposals = ResizeArray() try let outputDirectory = DirectoryInfo(tryCreateTemporaryDirectory()) @@ -509,10 +509,10 @@ module rec CompilerAssertHelpers = let rec returnCompilation (cmpl: Compilation) ignoreWarnings = let outputDirectory = match cmpl with - | Compilation(_, _, _, _, _, Some outputDirectory) -> DirectoryInfo(outputDirectory.FullName) - | Compilation(_, _, _, _, _, _) -> DirectoryInfo(tryCreateTemporaryDirectory()) + | Compilation(outputDirectory = Some outputDirectory) -> DirectoryInfo(outputDirectory.FullName) + | Compilation _ -> DirectoryInfo(tryCreateTemporaryDirectory()) - outputDirectory.Create() |> ignore + outputDirectory.Create() compileCompilationAux outputDirectory (ResizeArray()) ignoreWarnings cmpl let executeBuiltAppAndReturnResult (outputFilePath: string) (deps: string list) : (int * string * string) = @@ -623,10 +623,14 @@ Updated automatically, please check diffs in your pull request, changes must be static member DefaultProjectOptions = defaultProjectOptions static member GenerateFsInputPath() = - Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".fs")) + let path = Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".fs")) + printfn $"input path = {path}" + path static member GenerateDllOutputPath() = - Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".dll")) + let path = Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".dll")) + printfn $"output path = {path}" + path static member CompileWithErrors(cmpl: Compilation, expectedErrors, ?ignoreWarnings) = let ignoreWarnings = defaultArg ignoreWarnings false diff --git a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs index 57819a2f036..abb37e0b6c5 100644 --- a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs +++ b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs @@ -28,7 +28,7 @@ type DirectoryAttribute(dir: string) = result let dirInfo = normalizePathSeparator (Path.GetFullPath(dir)) - let outputDirectory name = + let outputDirectory methodName extraDirectory = // If the executing assembly has 'artifacts\bin' in it's path then we are operating normally in the CI or dev tests // Thus the output directory will be in a subdirectory below where we are executing. // The subdirectory will be relative to the source directory containing the test source file, @@ -36,7 +36,7 @@ type DirectoryAttribute(dir: string) = // When the source code is in: // $(repo-root)\tests\FSharp.Compiler.ComponentTests\Conformance\PseudoCustomAttributes // and the test is running in the FSharp.Compiler.ComponentTeststest library - // The output directory will be: + // The output directory will be: // artifacts\bin\FSharp.Compiler.ComponentTests\$(Flavour)\$(TargetFramework)\tests\FSharp.Compiler.ComponentTests\Conformance\PseudoCustomAttributes // // If we can't find anything then we execute in the directory containing the source @@ -51,7 +51,7 @@ type DirectoryAttribute(dir: string) = let testPaths = dirInfo.Replace(testRoot, "").Split('/') testPaths[0] <- "tests" Path.Combine(testPaths) - let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName name) + let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName methodName, extraDirectory) let outputDirectory = new DirectoryInfo(n) Some outputDirectory else @@ -69,13 +69,19 @@ type DirectoryAttribute(dir: string) = | true -> Some (File.ReadAllText path) | _ -> None - let createCompilationUnit path fs name = - let outputDirectory = outputDirectory name + let createCompilationUnit path (filename: string) methodName multipleFiles = + // if there are multiple files being processed, add extra directory for each test to avoid reference file conflicts + let extraDirectory = + if multipleFiles then + filename.Substring(0, filename.Length - 3) // remove .fs + |> normalizeName + else "" + let outputDirectory = outputDirectory methodName extraDirectory let outputDirectoryPath = match outputDirectory with | Some path -> path.FullName | None -> failwith "Can't set the output directory" - let sourceFilePath = normalizePathSeparator (path ++ fs) + let sourceFilePath = normalizePathSeparator (path ++ filename) let fsBslFilePath = sourceFilePath + ".err.bsl" let ilBslFilePath = let ilBslPaths = [| @@ -109,8 +115,8 @@ type DirectoryAttribute(dir: string) = | Some s -> s | None -> sourceFilePath + baselineSuffix + ".il.bsl" - let fsOutFilePath = normalizePathSeparator (Path.ChangeExtension(outputDirectoryPath ++ fs, ".err")) - let ilOutFilePath = normalizePathSeparator ( Path.ChangeExtension(outputDirectoryPath ++ fs, ".il")) + let fsOutFilePath = normalizePathSeparator (Path.ChangeExtension(outputDirectoryPath ++ filename, ".err")) + let ilOutFilePath = normalizePathSeparator ( Path.ChangeExtension(outputDirectoryPath ++ filename, ".il")) let fsBslSource = readFileOrDefault fsBslFilePath let ilBslSource = readFileOrDefault ilBslFilePath @@ -126,7 +132,7 @@ type DirectoryAttribute(dir: string) = } Options = [] OutputType = Library - Name = Some fs + Name = Some filename IgnoreWarnings = false References = [] OutputDirectory = outputDirectory } |> FS @@ -154,6 +160,8 @@ type DirectoryAttribute(dir: string) = if not <| FileSystem.FileExistsShim(f) then failwithf "Requested file \"%s\" not found.\nAll files: %A.\nIncludes:%A." f allFiles includes + let multipleFiles = fsFiles |> Array.length > 1 + fsFiles - |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name) + |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name multipleFiles) |> Seq.map (fun c -> [| c |]) diff --git a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs index 1c89e249e8f..289d171226e 100644 --- a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs +++ b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs @@ -561,8 +561,8 @@ namespace CSharpTest open System open CSharpTest -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f1 () = callStatic 1 2 @@ -4726,8 +4726,8 @@ open CSharpTest type I3 = inherit I2 -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - let value = ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + let value = (^T : (static member StaticMethod : int * int -> int) (x, y)) Console.Write value let f1 () = @@ -4882,8 +4882,8 @@ namespace CSharpTest open System open CSharpTest -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f () = callStatic 1 2 @@ -4935,8 +4935,8 @@ type FSharpClass() = interface I1 interface I2 -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f () = callStatic 1 2 diff --git a/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl b/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl index fa5c8fbaf67..1bd18780642 100644 --- a/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl +++ b/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl @@ -1,7 +1,7 @@ E_LessThanDotOpenParen001.fsx(23,12,23,15): typecheck error FS0043: No overloads match for method 'op_PlusPlusPlus'. -Known return type: ^a +Known return type: ^a Known type parameters: < (string -> int) , TestType > diff --git a/tests/fsharp/core/members/ops/test.fsx b/tests/fsharp/core/members/ops/test.fsx index 60d2570355f..4c0581d42ca 100644 --- a/tests/fsharp/core/members/ops/test.fsx +++ b/tests/fsharp/core/members/ops/test.fsx @@ -359,7 +359,7 @@ module MiscOperatorOverloadTests = module OperatorConstraintsWithExplicitRigidTypeParameters = type M() = class end - let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = let m = M() Unchecked.defaultof< ^R> $ m: ^R diff --git a/tests/fsharp/core/subtype/test.fsx b/tests/fsharp/core/subtype/test.fsx index 8ca98d0f472..a0bae709394 100644 --- a/tests/fsharp/core/subtype/test.fsx +++ b/tests/fsharp/core/subtype/test.fsx @@ -1838,7 +1838,7 @@ module SRTPFix = let inline fmap (f : ^a -> ^b) (a : ^c) = fmap_instance (f, a) - let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or ^b) : (static member replace : ^a * ^b -> ^a0) = + let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or ^b) : (static member replace : ^a * ^b -> ^a0) = replace_instance (a, f) (* diff --git a/tests/fsharp/core/syntax/test.fsx b/tests/fsharp/core/syntax/test.fsx index e26783d7f31..8ca6dbc98e1 100644 --- a/tests/fsharp/core/syntax/test.fsx +++ b/tests/fsharp/core/syntax/test.fsx @@ -89,7 +89,7 @@ module MoreDynamicOpTests = static member ($) (x:int , M) = 0 static member ($) (x:float , M) = 0.0 - let inline empty< ^R, ^M when (^R or ^M) : (static member ($) : ^R * M -> ^R) and ^M :> M> = + let inline empty< ^R, ^M when (^R or ^M) : (static member ($) : ^R * M -> ^R) and ^M :> M> = let m = M() ((^R or ^M) : (static member ($): ^R * M -> ^R ) (Unchecked.defaultof<'R>, m)) @@ -102,7 +102,7 @@ module MoreDynamicOpTests = static member ($) (x:int , M) = 0 static member ($) (x:float , M) = 0.0 - let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = let m = M() Unchecked.defaultof< ^R> $ m: ^R diff --git a/tests/fsharp/regression/5531/test.fs b/tests/fsharp/regression/5531/test.fs index 4059b772bfd..a8dfbdc5429 100644 --- a/tests/fsharp/regression/5531/test.fs +++ b/tests/fsharp/regression/5531/test.fs @@ -6,7 +6,7 @@ type Derived() = inherit Base() member this.Foo() = printfn "Derived" -let inline callFoo< ^T when ^T : (member Foo: unit -> unit) > (t: ^T) = +let inline callFoo<^T when ^T : (member Foo: unit -> unit) > (t: ^T) = (^T : (member Foo: unit -> unit) (t)) let b = Base() diff --git a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl index ee9b9d3dde2..fcd4fb9de75 100644 --- a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl +++ b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl @@ -1,7 +1,7 @@ neg_generic_known_argument_types.fsx(9,16,9,49): typecheck error FS0041: A unique overload for method 'Foo' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^fa * ^b -> ^b) and ^b: (member BBBB: ^b -> unit) +Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^b -> ^b) and ^b: (member BBBB: unit -> unit) Candidates: - static member A.Foo: argA1: 'a * argB1: ('a -> 'b) * argC1: ('a -> 'b) * argD: ('a -> 'b) * argZ1: 'zzz -> 'b diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl index dfe5a058b04..698171eac59 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl @@ -6,21 +6,21 @@ Known return type: MonoidSample Known type parameters: < MonoidSample , Zero > Available overloads: - - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member Zero: ^t) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member get_Empty: ^t) // Argument at index 1 doesn't match - static member Zero.Zero: 'a array * Zero -> 'a array // Argument at index 1 doesn't match - static member Zero.Zero: 'a list * Zero -> 'a list // Argument at index 1 doesn't match - static member Zero.Zero: 'a option * Zero -> 'a option // Argument at index 1 doesn't match - - static member Zero.Zero: ('T -> ^Monoid) * Zero -> ('T -> ^Monoid) when (Zero or ^Monoid) : (static member Zero: ^Monoid * Zero -> ^Monoid) // Argument at index 1 doesn't match - - static member Zero.Zero: Async< ^a> * Zero -> Async< ^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match - - static member Zero.Zero: Lazy< ^a> * Zero -> Lazy< ^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match + - static member Zero.Zero: ('T -> ^Monoid) * Zero -> ('T -> ^Monoid) when (Zero or ^Monoid) : (static member Zero: ^Monoid * Zero -> ^Monoid) // Argument at index 1 doesn't match + - static member Zero.Zero: Async<^a> * Zero -> Async<^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match + - static member Zero.Zero: Lazy<^a> * Zero -> Lazy<^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match - static member Zero.Zero: Map<'a,'b> * Zero -> Map<'a,'b> when 'a: comparison // Argument at index 1 doesn't match - static member Zero.Zero: ResizeArray<'a> * Zero -> ResizeArray<'a> // Argument at index 1 doesn't match - static member Zero.Zero: Set<'a> * Zero -> Set<'a> when 'a: comparison // Argument at index 1 doesn't match - static member Zero.Zero: System.TimeSpan * Zero -> System.TimeSpan // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member Zero: ^t) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member Empty: ^t) // Argument at index 1 doesn't match - static member Zero.Zero: seq<'a> * Zero -> seq<'a> // Argument at index 1 doesn't match - static member Zero.Zero: string * Zero -> string // Argument at index 1 doesn't match - static member Zero.Zero: unit * Zero -> unit // Argument at index 1 doesn't match diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx index db2b2ae297c..947735d0e84 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx @@ -74,7 +74,7 @@ type Zero with static member Zero (_: seq<'a> , _: Zero) = Seq.empty : seq<'a> let inline (++) (x: 'Monoid) (y: 'Monoid) : 'Monoid = Plus.Invoke x y -let inline zero< ^Monoid when (Zero or ^Monoid) : (static member Zero : ^Monoid * Zero -> ^Monoid) > : ^Monoid = Zero.Invoke () +let inline zero<^Monoid when (Zero or ^Monoid) : (static member Zero : ^Monoid * Zero -> ^Monoid) > : ^Monoid = Zero.Invoke () type MonoidSample = | MonoidSample of int diff --git a/tests/fsharp/typecheck/sigs/neg02.bsl b/tests/fsharp/typecheck/sigs/neg02.bsl index b7119f8e1d4..5e83ca4d14b 100644 --- a/tests/fsharp/typecheck/sigs/neg02.bsl +++ b/tests/fsharp/typecheck/sigs/neg02.bsl @@ -2,5 +2,3 @@ neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition - -neg02.fs(17,7,17,13): parse error FS0010: Unexpected keyword 'static' in member definition. Expected 'member', 'override' or other token. diff --git a/tests/fsharp/typecheck/sigs/neg02.vsbsl b/tests/fsharp/typecheck/sigs/neg02.vsbsl new file mode 100644 index 00000000000..914fb1c02a6 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg02.vsbsl @@ -0,0 +1,10 @@ + +neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# + +neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition + +neg02.fs(17,21,17,26): typecheck error FS3351: Feature 'static abstract interface members' is not supported by target runtime. + +neg02.fs(17,21,17,26): typecheck error FS3350: Feature 'static abstract interface members' is not available in F# 6.0. Please use language version 'PREVIEW' or greater. + +neg02.fs(17,21,17,24): typecheck error FS0855: No abstract or interface member was found that corresponds to this override diff --git a/tests/fsharp/typecheck/sigs/neg112.bsl b/tests/fsharp/typecheck/sigs/neg112.bsl index e6d4ed7bc8e..23711fb3b4d 100644 --- a/tests/fsharp/typecheck/sigs/neg112.bsl +++ b/tests/fsharp/typecheck/sigs/neg112.bsl @@ -1,6 +1,6 @@ -neg112.fs(20,49,20,62): typecheck error FS0001: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,49,20,62): typecheck error FS0001: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' -neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' -neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' diff --git a/tests/fsharp/typecheck/sigs/neg112.fs b/tests/fsharp/typecheck/sigs/neg112.fs index b544ee5834b..9fe032348cd 100644 --- a/tests/fsharp/typecheck/sigs/neg112.fs +++ b/tests/fsharp/typecheck/sigs/neg112.fs @@ -13,8 +13,8 @@ type IOption<'T> = let inline tupleMap f x = Tuple.Map f x -let inline addOptionValues< ^value, ^options, ^values, 'item when - 'item :> IOption< ^value>> +let inline addOptionValues<^value, ^options, ^values, 'item when + 'item :> IOption<^value>> (addUp : ^values -> ^value, sourceOptions : ^options) = let getValue (i : 'item) = i.Value let allValues : ^values = tupleMap getValue sourceOptions diff --git a/tests/fsharp/typecheck/sigs/neg116.bsl b/tests/fsharp/typecheck/sigs/neg116.bsl index e5225d4225e..9bd22489ddc 100644 --- a/tests/fsharp/typecheck/sigs/neg116.bsl +++ b/tests/fsharp/typecheck/sigs/neg116.bsl @@ -1,7 +1,7 @@ neg116.fs(10,44,10,45): typecheck error FS0043: No overloads match for method 'op_Multiply'. -Known return type: ^a +Known return type: ^a Known type parameters: < float , Polynomial > diff --git a/tests/fsharp/typecheck/sigs/neg117.bsl b/tests/fsharp/typecheck/sigs/neg117.bsl index 8dd725f4721..44484072f2a 100644 --- a/tests/fsharp/typecheck/sigs/neg117.bsl +++ b/tests/fsharp/typecheck/sigs/neg117.bsl @@ -6,5 +6,5 @@ Known return type: ('a -> Neg117.TargetA.M1 Microsoft.FSharp.Core.[]) Known type parameters: < Neg117.TargetA.M1 Microsoft.FSharp.Core.[] , Microsoft.FSharp.Core.obj , Neg117.Superpower.Transformer > Available overloads: - - static member Neg117.Superpower.Transformer.Transform: ^f * Neg117.TargetB.TargetB * Neg117.Superpower.Transformer -> (Neg117.TargetB.TransformerKind -> ^f) when (Neg117.TargetB.TargetB or ^f) : (static member Transform: ^f * Neg117.TargetB.TargetB -> (Neg117.TargetB.TransformerKind -> ^f)) // Argument at index 1 doesn't match - - static member Neg117.Superpower.Transformer.Transform: ^r * Neg117.TargetA.TargetA * Neg117.Superpower.Transformer -> (Neg117.TargetA.TransformerKind -> ^r) when (Neg117.TargetA.TargetA or ^r) : (static member Transform: ^r * Neg117.TargetA.TargetA -> (Neg117.TargetA.TransformerKind -> ^r)) // Argument at index 1 doesn't match + - static member Neg117.Superpower.Transformer.Transform: ^f * Neg117.TargetB.TargetB * Neg117.Superpower.Transformer -> (Neg117.TargetB.TransformerKind -> ^f) when (Neg117.TargetB.TargetB or ^f) : (static member Transform: ^f * Neg117.TargetB.TargetB -> (Neg117.TargetB.TransformerKind -> ^f)) // Argument at index 1 doesn't match + - static member Neg117.Superpower.Transformer.Transform: ^r * Neg117.TargetA.TargetA * Neg117.Superpower.Transformer -> (Neg117.TargetA.TransformerKind -> ^r) when (Neg117.TargetA.TargetA or ^r) : (static member Transform: ^r * Neg117.TargetA.TargetA -> (Neg117.TargetA.TransformerKind -> ^r)) // Argument at index 1 doesn't match diff --git a/tests/fsharp/typecheck/sigs/neg119.bsl b/tests/fsharp/typecheck/sigs/neg119.bsl index 9bbdf9ccdaa..ffd7087e301 100644 --- a/tests/fsharp/typecheck/sigs/neg119.bsl +++ b/tests/fsharp/typecheck/sigs/neg119.bsl @@ -8,5 +8,5 @@ Known type parameters: < obj , Applicatives.Ap > Available overloads: - static member Applicatives.Ap.Return: ('r -> 'a) * Ap: Applicatives.Ap -> (('a -> 'r -> 'a2) -> 'a3 -> 'a -> 'r -> 'a2) // Argument at index 1 doesn't match - static member Applicatives.Ap.Return: System.Tuple<'a> * Ap: Applicatives.Ap -> ('a -> System.Tuple<'a>) // Argument at index 1 doesn't match - - static member Applicatives.Ap.Return: r: ^R * obj -> ('a1 -> ^R) when ^R: (static member Return: 'a1 -> ^R) // Argument 'r' doesn't match + - static member Applicatives.Ap.Return: r: ^R * obj -> ('a1 -> ^R) when ^R: (static member Return: 'a1 -> ^R) // Argument 'r' doesn't match - static member Applicatives.Ap.Return: seq<'a> * Ap: Applicatives.Ap -> ('a -> seq<'a>) // Argument at index 1 doesn't match Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg129.bsl b/tests/fsharp/typecheck/sigs/neg129.bsl index 82773932a9f..e15fe4a71a4 100644 --- a/tests/fsharp/typecheck/sigs/neg129.bsl +++ b/tests/fsharp/typecheck/sigs/neg129.bsl @@ -1,9 +1,9 @@ neg129.fs(67,47,67,54): typecheck error FS0043: 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: ^output +Known return type: ^output -Known type parameters: < bigint , ^output > +Known type parameters: < bigint , ^output > Candidates: - static member witnesses.convert_witness: x: bigint * _output: Complex -> Complex diff --git a/tests/fsharp/typecheck/sigs/neg131.bsl b/tests/fsharp/typecheck/sigs/neg131.bsl index 7015901cf41..2319a3914d4 100644 --- a/tests/fsharp/typecheck/sigs/neg131.bsl +++ b/tests/fsharp/typecheck/sigs/neg131.bsl @@ -4,5 +4,5 @@ neg131.fs(15,9,15,55): typecheck error FS0041: A unique overload for method 'Som Known types of arguments: 'a * ('b -> int) Candidates: - - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: ( ^T -> int) -> int when ^T: (member get_Length: ^T -> int) - 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) diff --git a/tests/fsharp/typecheck/sigs/neg132.bsl b/tests/fsharp/typecheck/sigs/neg132.bsl index ed2b768854a..5bed67dbd41 100644 --- a/tests/fsharp/typecheck/sigs/neg132.bsl +++ b/tests/fsharp/typecheck/sigs/neg132.bsl @@ -6,5 +6,5 @@ neg132.fs(15,9,15,55): typecheck error FS0041: A unique overload for method 'Som Known types of arguments: 'a * ('b -> int) Candidates: - - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: ( ^T -> int) -> int when ^T: (member get_Length: ^T -> int) - 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) diff --git a/tests/fsharp/typecheck/sigs/neg61.bsl b/tests/fsharp/typecheck/sigs/neg61.bsl index 1493d479a29..b1ba15a77ad 100644 --- a/tests/fsharp/typecheck/sigs/neg61.bsl +++ b/tests/fsharp/typecheck/sigs/neg61.bsl @@ -45,7 +45,7 @@ neg61.fs(56,16,56,19): typecheck error FS0039: The value or constructor 'zip' is neg61.fs(60,13,60,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(60,13,60,21): typecheck error FS0193: This expression is a function value, i.e. is missing arguments. Its type is ^a -> ^a. +neg61.fs(60,13,60,21): typecheck error FS0193: This expression is a function value, i.e. is missing arguments. Its type is ^a -> ^a. neg61.fs(64,13,64,20): 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. diff --git a/tests/fsharp/typecheck/sigs/pos35.fs b/tests/fsharp/typecheck/sigs/pos35.fs index 8848c965cd5..ed7c76a5617 100644 --- a/tests/fsharp/typecheck/sigs/pos35.fs +++ b/tests/fsharp/typecheck/sigs/pos35.fs @@ -138,7 +138,7 @@ module SelectOverloadedWitnessBasedOnReturnTypeByPassingDummyArgumentAndUsingOut // // The resulting type is like this: // - // val inline inst : num:bigint -> ^output when (witnesses or bigint or ^output) : (static member convert_witness : bigint * ^output -> ^output) + // val inline inst : num:bigint -> ^output when (witnesses or bigint or ^output) : (static member convert_witness : bigint * ^output -> ^output) let inline inst (num: bigint) : ^output = convert num let i1 : int32 = inst 777I let i2 : int64 = inst 777I diff --git a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs index 943ef86b14a..8cfbdf32924 100644 --- a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs +++ b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs @@ -4,8 +4,8 @@ // Verify error with malformed short unicode character // NOTE: I've jazzed up the error messages since they will be interprited as RegExs... -//Unexpected quote symbol in binding -//Unexpected quote symbol in binding +//Unexpected character '\\' in expression. Expected identifier or other token +//Unexpected character '\\' in expression. Expected identifier or other token //Unexpected character '\\' in binding let tooShort = '\u266' diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx index 99363967af9..f399c1a6144 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx @@ -1,9 +1,9 @@ // #ByRef #Regression #inline // Regression test for DevDiv:122445 ("Internal compiler error when evaluating code with inline/byref") //val inline f: -// x: string -> y: nativeptr< \^a> -> bool -// when \^a: unmanaged and -// \^a: \(static member TryParse: string \* nativeptr< \^a> -> bool\) +// x: string -> y: nativeptr<\^a> -> bool +// when \^a: unmanaged and +// \^a: \(static member TryParse: string \* nativeptr<\^a> -> bool\) // Should compile just fine let inline f x (y:_ nativeptr) = (^a : (static member TryParse : string * ^a nativeptr -> bool)(x,y)) diff --git a/tests/projects/Sample_ConsoleApp_net7/Program.fs b/tests/projects/Sample_ConsoleApp_net7/Program.fs new file mode 100644 index 00000000000..c6b3afc58b6 --- /dev/null +++ b/tests/projects/Sample_ConsoleApp_net7/Program.fs @@ -0,0 +1,117 @@ +// SDK version 7.0.100-preview.6 or newer has to be installed for this to work +open System.Numerics + +type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = + static abstract op_Addition: 'T * 'T -> 'T // Produces FS3535, advanced feature warning. + +type ISinOperator<'T when 'T :> ISinOperator<'T>> = + static abstract Sin: 'T -> 'T // Produces FS3535, advanced feature warning. + +let square (x: 'T when 'T :> IMultiplyOperators<'T,'T,'T>) = x * x +// ^--- autocompletion works here + +let zero (x: 'T when 'T :> INumber<'T>) = 'T.Zero + +let add<'T when IAdditionOperators<'T, 'T, 'T>>(x: 'T) (y: 'T) = x + y +let min<'T when INumber<'T>> (x: 'T) (y: 'T) = 'T.Min(x, y) +// ^ ^-------^--- no type params autocompletion +// +-- no completion here + +// Some declaration tests: +let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = x + y +let fSin<'T when ISinOperator<'T>>(x: 'T) = sin x +let fAdd'(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = x + y +let fSin'(x: 'T when ISinOperator<'T>) = sin x +let fAdd''(x: #IAdditionOperator<'T>, y) = x + y // Produces FS0064 for x (the construct causes code to be less generic...) +let fSin''(x: #ISinOperator<'T>) = sin x // Produces FS0064 for x (the construct causes code to be less generic...) +let fAdd'''(x: #IAdditionOperator<_>, y) = x + y // Does not produce FS0064 +let fSin'''(x: #ISinOperator<_>) = sin x // Does not produce FS0064 + +type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + +let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = + let mutable sum = 'T.Zero + for x in xs do + sum <- sum + x + 'T.DivideByInt(sum, xs.Length) +// ^--- autocomplete works here just fine + +let testZeroProp () = + let i = 1I + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1m + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1y + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1uy + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1s + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1us + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1l + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1ul + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1u + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1un + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1L + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1UL + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1F + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1.0 + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i : char = 'a' + let z = zero i + let h = System.Convert.ToByte(z).ToString("x2") + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {h} ({i.GetType().ToString()})" + + let i = '1'B + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + +[] +let main _ = + let x = 40 + let y = 20 + printfn $"Square of {x} is {square x}!" + printfn $"{x} + {y} is {add x y}!" + printfn $"Min of {x} and {y} is {min x y}" + + testZeroProp () + + 0 diff --git a/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj new file mode 100644 index 00000000000..622de34bbdb --- /dev/null +++ b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj @@ -0,0 +1,20 @@ + + + + Exe + net7.0 + preview + + + + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net6.0/fsc.dll + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net6.0/fsc.dll + False + True + + + + + + + diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index abb8dcbe10a..b02aef87d28 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -1909,3 +1909,4 @@ do let x = 1 in () | ToolTipText [ToolTipElement.Group [data]] -> data.MainDescription |> Array.map (fun text -> text.Text) |> String.concat "" |> shouldEqual "val x: int" | elements -> failwith $"Tooltip elements: {elements}" + diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 9a1f6d6bb56..69b4cf1fcb3 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -3334,7 +3334,7 @@ let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = nm |> shouldEqual "callX$W" argTypes.Count |> shouldEqual 1 let argText = argTypes[0].Type.ToString() - argText |> shouldEqual "type ^T -> ^U -> ^V" + argText |> shouldEqual "type ^T -> ^U -> ^V" end @@ -3356,8 +3356,8 @@ let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = let argText1 = argTypes[0].Type.ToString() let argName2 = argTypes[1].Name let argText2 = argTypes[1].Type.ToString() - argText1 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" - argText2 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + argText1 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + argText2 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" end @@ -3504,9 +3504,9 @@ let ``Test ProjectForWitnesses3 GetWitnessPassingInfo`` () = let argName2 = argTypes[1].Name let argText2 = argTypes[1].Type.ToString() argName1 |> shouldEqual (Some "get_Zero") - argText1 |> shouldEqual "type Microsoft.FSharp.Core.unit -> ^T" + argText1 |> shouldEqual "type Microsoft.FSharp.Core.unit -> ^T" argName2 |> shouldEqual (Some "op_Addition") - argText2 |> shouldEqual "type ^T -> ^T -> ^T" + argText2 |> shouldEqual "type ^T -> ^T -> ^T" end //--------------------------------------------------------------------------------------------------------- diff --git a/tests/service/SyntaxTreeTests/MemberFlagTests.fs b/tests/service/SyntaxTreeTests/MemberFlagTests.fs index 464884ae055..b95d91bae9d 100644 --- a/tests/service/SyntaxTreeTests/MemberFlagTests.fs +++ b/tests/service/SyntaxTreeTests/MemberFlagTests.fs @@ -89,25 +89,25 @@ type Foo = SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ - SynMemberDefn.AutoProperty(memberFlags= mkFlags1) - SynMemberDefn.AutoProperty(memberFlags= mkFlags2) - SynMemberDefn.AutoProperty(memberFlags= mkFlags3) - SynMemberDefn.AutoProperty(memberFlags= mkFlags4) + SynMemberDefn.AutoProperty(memberFlags= flags1) + SynMemberDefn.AutoProperty(memberFlags= flags2) + SynMemberDefn.AutoProperty(memberFlags= flags3) + SynMemberDefn.AutoProperty(memberFlags= flags4) ])) ], _) ]) ])) -> - let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = mkFlags1 SynMemberKind.Member + let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = flags1 assertRange (3, 4) (3, 10) flagsTrivia1.StaticRange.Value assertRange (3, 11) (3, 17) flagsTrivia1.MemberRange.Value - let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = mkFlags2 SynMemberKind.Member + let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = flags2 assertRange (4, 4) (4, 10) flagsTrivia2.MemberRange.Value - let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = mkFlags3 SynMemberKind.Member + let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = flags3 assertRange (5, 4) (5, 12) flagsTrivia3.OverrideRange.Value - let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = mkFlags4 SynMemberKind.Member + let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = flags4 assertRange (6, 4) (6, 11) flagsTrivia4.DefaultRange.Value | _ -> Assert.Fail "Could not get valid AST" diff --git a/vsintegration/tests/Directory.Build.props b/vsintegration/tests/Directory.Build.props deleted file mode 100644 index 5737505f968..00000000000 --- a/vsintegration/tests/Directory.Build.props +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - true - portable - - - diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index e94163042e4..f0a158b694b 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/BreakpointResolutionService.fs b/vsintegration/tests/UnitTests/BreakpointResolutionService.fs index 09b5e105857..1081471994e 100644 --- a/vsintegration/tests/UnitTests/BreakpointResolutionService.fs +++ b/vsintegration/tests/UnitTests/BreakpointResolutionService.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -72,7 +72,7 @@ let main argv = let searchPosition = code.IndexOf(searchToken) Assert.IsTrue(searchPosition >= 0, "SearchToken '{0}' is not found in code", searchToken) - let document, sourceText = RoslynTestHelpers.CreateDocument(fileName, code) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, code) let searchSpan = TextSpan.FromBounds(searchPosition, searchPosition + searchToken.Length) let actualResolutionOption = FSharpBreakpointResolutionService.GetBreakpointLocation(document, searchSpan) |> Async.RunSynchronously diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index ea808bc81a9..debcc4296a8 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -2,7 +2,7 @@ // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.CompletionProviderTests +module VisualFSharp.UnitTests.Editor.CompletionProviderTests open System open System.Linq @@ -36,8 +36,9 @@ let formatCompletions(completions : string seq) = "\n\t" + String.Join("\n\t", completions) let VerifyCompletionListWithOptions(fileContents: string, marker: string, expected: string list, unexpected: string list, opts) = + let options = projectOptions opts let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let results = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) |> Async.RunSynchronously @@ -46,23 +47,23 @@ let VerifyCompletionListWithOptions(fileContents: string, marker: string, expect let expectedFound = expected - |> Seq.filter results.Contains + |> List.filter results.Contains let expectedNotFound = expected - |> Seq.filter (expectedFound.Contains >> not) + |> List.filter (expectedFound.Contains >> not) let unexpectedNotFound = unexpected - |> Seq.filter (results.Contains >> not) + |> List.filter (results.Contains >> not) let unexpectedFound = unexpected - |> Seq.filter (unexpectedNotFound.Contains >> not) + |> List.filter (unexpectedNotFound.Contains >> not) // If either of these are true, then the test fails. - let hasExpectedNotFound = not (Seq.isEmpty expectedNotFound) - let hasUnexpectedFound = not (Seq.isEmpty unexpectedFound) + let hasExpectedNotFound = not (List.isEmpty expectedNotFound) + let hasUnexpectedFound = not (List.isEmpty unexpectedFound) if hasExpectedNotFound || hasUnexpectedFound then let expectedNotFoundMsg = @@ -82,13 +83,15 @@ let VerifyCompletionListWithOptions(fileContents: string, marker: string, expect let msg = sprintf "%s%s%s" expectedNotFoundMsg unexpectedFoundMsg completionsMsg Assert.Fail(msg) + let VerifyCompletionList(fileContents, marker, expected, unexpected) = VerifyCompletionListWithOptions(fileContents, marker, expected, unexpected, [| |]) -let VerifyCompletionListExactly(fileContents: string, marker: string, expected: string list) = +let VerifyCompletionListExactlyWithOptions(fileContents: string, marker: string, expected: string list, opts) = + let options = projectOptions opts let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let actual = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) |> Async.RunSynchronously @@ -105,6 +108,9 @@ let VerifyCompletionListExactly(fileContents: string, marker: string, expected: (String.Join("; ", actualNames |> List.map (sprintf "\"%s\""))) (String.Join("\n", actual |> List.map (fun x -> sprintf "%s => %s" x.DisplayText x.SortText)))) +let VerifyCompletionListExactly(fileContents: string, marker: string, expected: string list) = + VerifyCompletionListExactlyWithOptions(fileContents, marker, expected, [| |]) + let VerifyNoCompletionList(fileContents: string, marker: string) = VerifyCompletionListExactly(fileContents, marker, []) @@ -333,7 +339,7 @@ type T1 = member this.M2 = "literal" let x = $"1 not the same as {System.Int32.MaxValue} is it" """ - VerifyCompletionListWithOptions(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"], [| "/langversion:preview" |]) + VerifyCompletionList(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"]) [] let ``Class instance members are ordered according to their kind and where they are defined (simple case, by a variable)``() = @@ -860,6 +866,44 @@ let emptyMap<'keyType, 'lValueType> () = """ VerifyCompletionList(fileContents, ", l", ["LanguagePrimitives"; "List"; "lValueType"], ["let"; "log"]) -#if EXE -ShouldDisplaySystemNamespace() -#endif +[] +let ``Completion list for interface with static abstract method type invocation contains static property with residue``() = + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + VerifyCompletionListWithOptions(fileContents, "'T.Stati", ["StaticProperty"], [], [| "/langversion:preview" |]) + +[] +let ``Completion list for interface with static abstract method type invocation contains static property after dot``() = + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + VerifyCompletionListWithOptions(fileContents, "'T.", ["StaticProperty"], [], [| "/langversion:preview" |]) + + +[] +let ``Completion list for SRTP invocation contains static property with residue``() = + let fileContents = """ +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + +""" + VerifyCompletionListWithOptions(fileContents, "'T.Stati", ["StaticProperty"], [], [| "/langversion:preview" |]) + +[] +let ``Completion list for SRTP invocation contains static property after dot``() = + let fileContents = """ +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + +""" + VerifyCompletionListWithOptions(fileContents, "'T.", ["StaticProperty"], [], [| "/langversion:preview" |]) + diff --git a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs index c9674a89861..b438c0b96ff 100644 --- a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -40,7 +40,7 @@ type DocumentDiagnosticAnalyzerTests() = let getDiagnostics (fileContents: string) = async { - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let! syntacticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document, DiagnosticsType.Syntax) let! semanticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document, DiagnosticsType.Semantic) return syntacticDiagnostics.AddRange(semanticDiagnostics) diff --git a/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs b/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs index 8ca66298300..322d3f37eed 100644 --- a/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs +++ b/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs @@ -4,7 +4,7 @@ // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests [] -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.DocumentHighlightsServiceTests +module VisualFSharp.UnitTests.Editor.DocumentHighlightsServiceTests open System open System.Threading @@ -36,7 +36,7 @@ let internal projectOptions = { } let private getSpans (sourceText: SourceText) (caretPosition: int) = - let document = RoslynTestHelpers.CreateDocument(filePath, sourceText) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, sourceText) FSharpDocumentHighlightsService.GetDocumentHighlights(document, caretPosition) |> Async.RunSynchronously |> Option.defaultValue [||] diff --git a/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs b/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs index 915129f0c17..739b2600f6e 100644 --- a/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs +++ b/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System diff --git a/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs b/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs index 4a0e2f2dcfe..45a415ea187 100644 --- a/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs @@ -2,7 +2,7 @@ // // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Collections.Generic @@ -40,7 +40,7 @@ type Worker () = member _.VerifyCompletionListExactly(fileContents: string, marker: string, expected: List) = let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document = RoslynTestHelpers.CreateDocument(filePath, SourceText.From(fileContents), options = projectOptions) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, SourceText.From(fileContents), options = projectOptions) let expected = expected |> Seq.toList let actual = let x = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) @@ -76,6 +76,3 @@ module FsxCompletionProviderTests = // We execute in a seperate appdomain so that we can set BaseDirectory to a non-existent location getWorker().VerifyCompletionListExactly(fileContents, "fsi.", expected) -#if EXE -ShouldTriggerCompletionInFsxFile() -#endif diff --git a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs index 811086e051f..fa9e0ca2937 100644 --- a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs +++ b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs @@ -2,7 +2,7 @@ // // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.IO @@ -17,7 +17,7 @@ open FSharp.Compiler.EditorServices open FSharp.Compiler.Text open UnitTests.TestLib.LanguageService -[][] +[] module GoToDefinitionServiceTests = let userOpName = "GoToDefinitionServiceTests" @@ -58,13 +58,14 @@ module GoToDefinitionServiceTests = Stamp = None } - let GoToDefinitionTest (fileContents: string, caretMarker: string, expected) = + let GoToDefinitionTest (fileContents: string, caretMarker: string, expected, opts) = let filePath = Path.GetTempFileName() + ".fs" File.WriteAllText(filePath, fileContents) + let options = makeOptions filePath opts let caretPosition = fileContents.IndexOf(caretMarker) + caretMarker.Length - 1 // inside the marker - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let actual = findDefinition(document, sourceText, caretPosition, []) |> Option.map (fun range -> (range.StartLine, range.EndLine, range.StartColumn, range.EndColumn)) @@ -73,7 +74,7 @@ module GoToDefinitionServiceTests = Assert.Fail(sprintf "Incorrect information returned for fileContents=<<<%s>>>, caretMarker=<<<%s>>>, expected =<<<%A>>>, actual = <<<%A>>>" fileContents caretMarker expected actual) [] - let VerifyDefinition() = + let ``goto definition smoke test``() = let manyTestCases = [ @@ -110,10 +111,10 @@ let _ = Module1.foo 1 for caretMarker, expected in testCases do printfn "Test case: caretMarker=<<<%s>>>" caretMarker - GoToDefinitionTest (fileContents, caretMarker, expected) + GoToDefinitionTest (fileContents, caretMarker, expected, [| |]) [] - let VerifyDefinitionStringInterpolation() = + let ``goto definition for string interpolation``() = let fileContents = """ let xxxxx = 1 @@ -121,9 +122,19 @@ let yyyy = $"{abc{xxxxx}def}" """ let caretMarker = "xxxxx" let expected = Some(2, 2, 4, 9) - GoToDefinitionTest (fileContents, caretMarker, expected) + GoToDefinitionTest (fileContents, caretMarker, expected, [| |]) -#if EXE - VerifyDefinition() - VerifyDefinitionStringInterpolation() -#endif \ No newline at end of file + [] + let ``goto definition for static abstract method invocation``() = + + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + let caretMarker = "'T.StaticProperty" + let expected = Some(3, 3, 20, 34) + + GoToDefinitionTest (fileContents, caretMarker, expected, [| "/langversion:preview" |]) diff --git a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs index b1ea19c2ad7..248535527f3 100644 --- a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs +++ b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -10,7 +10,7 @@ open Microsoft.CodeAnalysis.Classification open Microsoft.CodeAnalysis.Editor open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis -open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.CodeAnalysis open Microsoft.VisualStudio.FSharp.Editor open Microsoft.VisualStudio.FSharp.LanguageService open UnitTests.TestLib.Utils @@ -19,63 +19,58 @@ open UnitTests.TestLib.LanguageService [][] type HelpContextServiceTests() = - let fileName = "C:\\test.fs" - let options: FSharpProjectOptions = { - ProjectFileName = "C:\\test.fsproj" - ProjectId = None - SourceFiles = [| fileName |] - ReferencedProjects = [| |] - OtherOptions = [| |] - IsIncompleteTypeCheckEnvironment = true - UseScriptResolutionRules = false - LoadTime = DateTime.MaxValue - UnresolvedReferences = None - ExtraProjectInfo = None - OriginalLoadReferences = [] - Stamp = None - } - - let markers (source:string) = + let filePath = "C:\\test.fs" + let makeOptions args = + { + ProjectFileName = "C:\\test.fsproj" + ProjectId = None + SourceFiles = [| filePath |] + ReferencedProjects = [| |] + OtherOptions = args + IsIncompleteTypeCheckEnvironment = true + UseScriptResolutionRules = false + LoadTime = DateTime.MaxValue + OriginalLoadReferences = [] + UnresolvedReferences = None + Stamp = None + } + + let getMarkers (source:string) = let mutable cnt = 0 - [ - for i in 0 .. (source.Length - 1) do - if source.[i] = '$' then - yield (i - cnt) - cnt <- cnt + 1 + [ for i in 0 .. (source.Length - 1) do + if source.[i] = '$' then + yield (i - cnt) + cnt <- cnt + 1 ] - member private this.TestF1Keywords(expectedKeywords: string option list, lines : string list, ?addtlRefAssy : list) = - let newOptions = - let refs = - defaultArg addtlRefAssy [] - |> List.map (fun r -> "-r:" + r) - |> Array.ofList - { options with OtherOptions = Array.append options.OtherOptions refs } - - let fileContents = String.Join("\r\n", lines) - let version = fileContents.GetHashCode() - let sourceText = SourceText.From(fileContents.Replace("$", "")) - - let res = [ - for marker in markers fileContents do - let span = Microsoft.CodeAnalysis.Text.TextSpan(marker, 0) - let textLine = sourceText.Lines.GetLineFromPosition(marker) - let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) - let classifiedSpans = Tokenizer.getClassifiedSpans(documentId, sourceText, textLine.Span, Some "test.fs", [], CancellationToken.None) - - yield FSharpHelpContextService.GetHelpTerm(checker, sourceText, fileName, newOptions, span, classifiedSpans, version) - |> Async.RunSynchronously - ] - let equalLength = List.length expectedKeywords = List.length res + let TestF1KeywordsWithOptions(expectedKeywords: string option list, lines : string list, opts : string[]) = + let options = makeOptions opts + + let fileContentsWithMarkers = String.Join("\r\n", lines) + let fileContents = fileContentsWithMarkers.Replace("$", "") + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) + + let markers = getMarkers fileContentsWithMarkers + let res = + [ for marker in markers do + let span = Microsoft.CodeAnalysis.Text.TextSpan(marker, 0) + let textLine = sourceText.Lines.GetLineFromPosition(marker) + let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let classifiedSpans = Tokenizer.getClassifiedSpans(documentId, sourceText, textLine.Span, Some "test.fs", [], CancellationToken.None) + + FSharpHelpContextService.GetHelpTerm(document, span, classifiedSpans) |> Async.RunSynchronously + ] + let equalLength = (expectedKeywords.Length = res.Length) Assert.True(equalLength) - List.iter2(fun exp res -> + for (exp, res) in List.zip expectedKeywords res do Assert.AreEqual(exp, res) - ) expectedKeywords res + let TestF1Keywords(expectedKeywords, lines) = + TestF1KeywordsWithOptions(expectedKeywords, lines, [| |]) [] - member public this.``NoKeyword.Negative`` () = + member _.``F1 help keyword NoKeyword.Negative`` () = let file = [ "let s = \"System.Con$sole\"" "let n = 999$99" @@ -84,19 +79,19 @@ type HelpContextServiceTests() = "#endif" ] let keywords = [ None; None; None ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Preprocessor`` () = + member _.``F1 help keyword Preprocessor`` () = let file = [ "#i$f foobaz" "#e$ndif" ] let keywords = [ Some "#if_FS"; Some "#endif_FS" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.DotNetMethod.854364``() = + member _.``F1 help keyword Regression.DotNetMethod.854364``() = let file = [ "let i : int = 42" "i.ToStri$ng()" @@ -106,10 +101,10 @@ type HelpContextServiceTests() = [ Some "System.Int32.ToString" Some "System.Int32.ToString" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces`` () = + member _.``F1 help keyword Namespaces`` () = let file = [ "open Syst$em.N$et" "open System.I$O" @@ -123,10 +118,10 @@ type HelpContextServiceTests() = Some "System.IO" Some "System.Console" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces.BeforeDot`` () = + member _.``F1 help keyword Namespaces.BeforeDot`` () = let file = [ "open System$.Net$" "open System$.IO" @@ -145,10 +140,10 @@ type HelpContextServiceTests() = Some "System" Some "System.Console" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces.AfterDot`` () = + member _.``F1 help keyword Namespaces.AfterDot`` () = let file = [ "open $System.$Net" "open $System.IO" @@ -168,10 +163,10 @@ type HelpContextServiceTests() = Some "System.Console" Some "System.Console.WriteLine" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``QuotedIdentifiers``() = + member _.``F1 help keyword QuotedIdentifiers``() = let file = [ "let `$`escaped func`` x y = x + y" @@ -193,10 +188,10 @@ type HelpContextServiceTests() = Some "Test.z" Some "Test.z" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Attributes`` () = + member _.``F1 help keyword Attributes`` () = let file = [ "open System.Runtime.InteropServices" @@ -206,7 +201,7 @@ type HelpContextServiceTests() = " []" " val mutable f : int" " []" - " member this.Run() = ()" + " member _.Run() = ()" "[]" "type Y = class end" ] @@ -217,14 +212,14 @@ type HelpContextServiceTests() = Some "System.Runtime.CompilerServices.MethodImplAttribute.#ctor" Some "System.Runtime.InteropServices.StructLayoutAttribute.Size" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] [] [] //This test case Verify that when F1 is Hit on TypeProvider namespaces it contain the right keyword - member public this.``TypeProvider.Namespaces`` () = + member _.``F1 help keyword TypeProvider.Namespaces`` () = let file = [ "open N$1" @@ -233,14 +228,13 @@ type HelpContextServiceTests() = [ Some "N1" ] - this.TestF1Keywords(keywords, file, - addtlRefAssy = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) + TestF1KeywordsWithOptions(keywords, file, [| "-r:" + PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll") |]) [] [] [] //This test case Verify that when F1 is Hit on TypeProvider Type it contain the right keyword - member public this.``TypeProvider.type`` () = + member _.``F1 help keyword TypeProvider.type`` () = let file = [ @@ -251,11 +245,10 @@ type HelpContextServiceTests() = [ Some "N1.T" ] - this.TestF1Keywords(keywords, file, - addtlRefAssy = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) + TestF1KeywordsWithOptions(keywords, file, [| "-r:"+PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll") |]) [] - member public this.``EndOfLine``() = + member _.``F1 help keyword EndOfLine``() = let file = [ "open System.Net$" "open System.IO$" @@ -264,10 +257,10 @@ type HelpContextServiceTests() = [ Some "System.Net" Some "System.IO" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``EndOfLine2``() = + member _.``F1 help keyword EndOfLine2``() = let file = [ "module M" "open System.Net$" @@ -277,21 +270,21 @@ type HelpContextServiceTests() = [ Some "System.Net" Some "System.IO" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Comments``() = + member _.``F1 help keyword Comments``() = let file = [ "($* co$mment *$)" "/$/ com$ment" ] let keywords = [ Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``FSharpEntities`` () = + member _.``F1 help keyword FSharpEntities`` () = let file = [ "let (KeyValu$e(k,v)) = null" "let w : int lis$t = []" @@ -320,10 +313,10 @@ type HelpContextServiceTests() = Some "Microsoft.FSharp.Core.Operators.Ref``1" Some "Microsoft.FSharp.Core.FSharpRef`1.contents" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Keywords`` () = + member _.``F1 help keyword Keywords`` () = let file = [ "l$et r = ref 0" "r :$= 1" @@ -338,66 +331,66 @@ type HelpContextServiceTests() = Some "<-_FS" Some "let_FS" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.NewInstance.854367`` () = + member _.``F1 help keyword Regression.NewInstance.854367`` () = let file = [ "let q : System.Runtime.Remoting.TypeE$ntry = null" ] let keywords = [ Some "System.Runtime.Remoting.TypeEntry" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.NewInstance.854367.2`` () = + member _.``F1 help keyword Regression.NewInstance.854367.2`` () = let file = [ "let q1 = new System.Runtime.Remoting.Type$Entry()" // this consutrctor exists but is not accessible (it is protected), but the help entry still goes to the type ] let keywords = [ Some "System.Runtime.Remoting.TypeEntry" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.WebClient`` () = + member _.``F1 help keyword Classes.WebClient`` () = let file = [ "let w : System.Net.Web$Client = new System.Net.Web$Client()" ] let keywords = [ Some "System.Net.WebClient" Some "System.Net.WebClient.#ctor" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Object`` () = + member _.``F1 help keyword Classes.Object`` () = let file = [ "let w : System.Ob$ject = new System.Obj$ect()" ] let keywords = [ Some "System.Object" Some "System.Object.#ctor" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Generic`` () = + member _.``F1 help keyword Classes.Generic`` () = let file = [ "let x : System.Collections.Generic.L$ist = null" ] let keywords = [ Some "System.Collections.Generic.List`1" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Abbrev`` () = + member _.``F1 help keyword Classes.Abbrev`` () = let file = [ "let z : Resi$zeArray = null" ] let keywords = [ Some "System.Collections.Generic.List`1" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Members`` () = + member _.``F1 help keyword Members`` () = let file = [ "open System.Linq" "open System" @@ -422,4 +415,17 @@ type HelpContextServiceTests() = Some "System.String.Equals" Some "System.Int32.ToString" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) + + [] + member _.``F1 help keyword static abstract interface method`` () = + let file = + ["type IStaticProperty<'T when 'T :> IStaticProperty<'T>> =" + " static abstract StaticProperty: 'T" + "" + "let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) =" + " 'T.StaticProp$erty" ] + let keywords = + [ Some "Test.IStaticProperty`1.StaticProperty" ] + TestF1Keywords(keywords, file) + diff --git a/vsintegration/tests/UnitTests/IndentationServiceTests.fs b/vsintegration/tests/UnitTests/IndentationServiceTests.fs index 7c535ccdff9..477fa4b2e93 100644 --- a/vsintegration/tests/UnitTests/IndentationServiceTests.fs +++ b/vsintegration/tests/UnitTests/IndentationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs b/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs index 6c2968a16ca..76dc7a54681 100644 --- a/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs +++ b/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index e147e34f840..846b401b227 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -395,9 +395,11 @@ type staticInInterface = end end""" - CheckErrorList fileContent <| function - | [err] -> Assert.IsTrue(err.Message.Contains("Unexpected keyword 'static' in member definition. Expected 'member', 'override' or other token")) - | x -> Assert.Fail(sprintf "Unexpected errors: %A" x) + CheckErrorList fileContent (function + | err1 :: _ -> + Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) + | x -> + Assert.Fail(sprintf "Unexpected errors: %A" x)) [] [] diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index 6e2f5b08e7c..f97e58ce654 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -34,6 +34,17 @@ type References() = l.[0] + /// Create a dummy project named 'Test', build it, and then call k with the full path to the resulting exe + member this.CreateDummyTestProjectBuildItAndDo(k : string -> unit) = + this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> + // Let's create a run-of-the-mill project just to have a spare assembly around + let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") + File.AppendAllText(fooPath, "namespace Foo\nmodule Bar =\n let x = 42") + let buildResult = project.Build("Build") + Assert.IsTrue buildResult.IsSuccessful + let exe = Path.Combine(project.ProjectFolder, "bin\\Debug\\Test.exe") + k exe)) + [] member this.``BasicAssemblyReferences1``() = this.MakeProjectAndDo([], ["System"], "", (fun proj -> @@ -49,7 +60,7 @@ type References() = )) [] - member public this.``AddReference.StarredAssemblyName`` () = + member this.``AddReference.StarredAssemblyName`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) use project = TheTests.CreateProject(projFile) @@ -69,7 +80,7 @@ type References() = ) [] - member public this.``References.Bug787899.AddDuplicateUnresolved``() = + member this.``References.Bug787899.AddDuplicateUnresolved``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -86,7 +97,7 @@ type References() = ) [] - member public this.``References.Bug787899.AddDuplicateResolved``() = + member this.``References.Bug787899.AddDuplicateResolved``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -106,7 +117,7 @@ type References() = ) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.Works``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.Works``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["mscorlib"; "System"; "System.Core"; "System.Net"], "", "v4.0", (fun project -> let expectedRefInfo = [ "mscorlib", true "System", true @@ -124,7 +135,7 @@ type References() = [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WithExactDuplicates``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WithExactDuplicates``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["System"; "System"], "", "v4.0", (fun project -> let expectedRefInfo = [ "System", true // In C#, one will be banged out, whereas "System", true] // one will be ok, but in F# both show up as ok. Bug? Not worth the effort to fix. @@ -139,7 +150,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WithBadDuplicates``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WithBadDuplicates``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["System"; "System.dll"], "", "v4.0", (fun project -> let expectedRefInfo = [ "System", false // one will be banged out "System.dll", true] // one will be ok @@ -154,7 +165,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WorksWithFilenames``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WorksWithFilenames``() = let netDir = currentFrameworkDirectory let ssmw = Path.Combine(netDir, "System.ServiceModel.Web.dll") this.MakeProjectAndDo(["doesNotMatter.fs"], [ssmw], "", "v4.0", (fun project -> @@ -170,7 +181,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WeirdCases``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WeirdCases``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["mscorlib, Version=4.0.0.0"; "System, Version=4.0.0.0"; "System.Core, Version=4.0.0.0"; "System.Net, Version=4.0.0.0"], "", "v4.0", (fun project -> let expectedRefInfo = [ "mscorlib", true "System", true @@ -186,10 +197,10 @@ type References() = AssertEqual expectedRefInfo actualRefInfo )) - member public this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string) = + member this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string) = this.ReferenceResolutionHelper(tab, fullPath, expectedFsprojRegex, "v4.0", []) - member public this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string, targetFrameworkVersion : string, originalReferences : string list) = + member this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string, targetFrameworkVersion : string, originalReferences : string list) = // Trace.Log <- "ProjectSystemReferenceResolution" // can be useful this.MakeProjectAndDo(["doesNotMatter.fs"], originalReferences, "", targetFrameworkVersion, (fun project -> let cType = @@ -207,7 +218,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate1``() = + member this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate1``() = let netDir = currentFrameworkDirectory try this.ReferenceResolutionHelper(AddReferenceDialogTab.DotNetTab, @@ -219,8 +230,8 @@ type References() = with e -> TheTests.HelpfulAssertMatches ' ' "A reference to '.*' \\(with assembly name '.*'\\) could not be added. A reference to the component '.*' with the same assembly name already exists in the project." e.Message - // see 5491 [] - member public this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate2``() = +// see 5491 [] + member this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate2``() = let netDir = currentFrameworkDirectory try this.ReferenceResolutionHelper(AddReferenceDialogTab.DotNetTab, @@ -232,19 +243,8 @@ type References() = with e -> TheTests.HelpfulAssertMatches ' ' "A reference to '.*' could not be added. A reference to the component '.*' already exists in the project." e.Message - /// Create a dummy project named 'Test', build it, and then call k with the full path to the resulting exe - member public this.CreateDummyTestProjectBuildItAndDo(k : string -> unit) = - this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> - // Let's create a run-of-the-mill project just to have a spare assembly around - let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") - File.AppendAllText(fooPath, "namespace Foo\nmodule Bar =\n let x = 42") - let buildResult = project.Build("Build") - Assert.IsTrue buildResult.IsSuccessful - let exe = Path.Combine(project.ProjectFolder, "bin\\Debug\\Test.exe") - k exe)) - [] - member public this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.InsideProjectDir``() = + member this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.InsideProjectDir``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -274,9 +274,9 @@ type References() = Assert.IsTrue buildResult.IsSuccessful )) ) - + [] - member public this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.OutsideProjectDir``() = + member this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.OutsideProjectDir``() = this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> // Let's create a run-of-the-mill let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") @@ -310,7 +310,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.NotAValidDll.BrowseTab``() = + member this.``ReferenceResolution.Bug4423.NotAValidDll.BrowseTab``() = let dirName = Path.GetTempPath() let dll = Path.Combine(dirName, "Foo.dll") File.AppendAllText(dll, "This is not actually a valid dll") @@ -328,7 +328,7 @@ type References() = File.Delete(dll) [] - member public this.``PathReferences.Existing`` () = + member this.``PathReferences.Existing`` () = DoWithTempFile "Test.fsproj"(fun projFile -> let dirName = Path.GetDirectoryName(projFile) let libDirName = Directory.CreateDirectory(Path.Combine(dirName, "lib")).FullName @@ -359,7 +359,7 @@ type References() = ) [] - member public this.``PathReferences.Existing.Captions`` () = + member this.``PathReferences.Existing.Captions`` () = DoWithTempFile "Test.fsproj"(fun projFile -> File.AppendAllText(projFile, TheTests.FsprojTextWithProjectReferences( [], // @@ -377,7 +377,7 @@ type References() = ) [] - member public this.``PathReferences.NonExistent`` () = + member this.``PathReferences.NonExistent`` () = DoWithTempFile "Test.fsproj"(fun projFile -> let refLibPath = @"c:\foo\baz\blahblah.dll" File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [refLibPath], "")) @@ -391,7 +391,7 @@ type References() = [] - member public this.``FsprojPreferencePage.ProjSupportsPrefReadWrite``() = + member this.``FsprojPreferencePage.ProjSupportsPrefReadWrite``() = let testProp = "AssemblyName" let compileItem = [@"foo.fs"] @@ -423,11 +423,12 @@ type References() = AssertContains contents newPropVal ) + // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 // On DEV 15 Preview 4 the VS IDE Test fails with : // System.InvalidOperationException : Operation is not valid due to the current state of the object. // [] // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 - member public this.``AddReference.COM`` () = + member this.``AddReference.COM`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) use project = TheTests.CreateProject(projFile) diff --git a/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs b/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs index 847adf617b2..f9a20e674d6 100644 --- a/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs +++ b/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs @@ -1,4 +1,4 @@ -namespace VisualFSharp.UnitTests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.IO diff --git a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs index d55dc57e2ac..7d5aa2613fd 100644 --- a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs @@ -6,7 +6,7 @@ // ------------------------------------------------------------------------------------------------------------------------ -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework @@ -82,7 +82,7 @@ let ShouldShowQuickInfoAtCorrectPositions() = System.Console.WriteLine(x + y) """ let caretPosition = fileContents.IndexOf(symbol) - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let quickInfo = FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) @@ -212,7 +212,7 @@ let res7 = sin 5.0 let res8 = abs 5.0 """ let caretPosition = fileContents.IndexOf(symbol) + symbol.Length - 1 - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let quickInfo = FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) diff --git a/vsintegration/tests/UnitTests/QuickInfoTests.fs b/vsintegration/tests/UnitTests/QuickInfoTests.fs index 9492088f753..fe45fead284 100644 --- a/vsintegration/tests/UnitTests/QuickInfoTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoTests.fs @@ -1,11 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System.IO open Microsoft.VisualStudio.FSharp.Editor open NUnit.Framework -open VisualFSharp.UnitTests.Roslyn +open VisualFSharp.UnitTests.Editor [] module QuickInfo = @@ -13,7 +13,7 @@ module QuickInfo = let internal GetQuickInfo (project:FSharpProject) (fileName:string) (caretPosition:int) = async { let code = File.ReadAllText(fileName) - let document, _ = RoslynTestHelpers.CreateDocument(fileName, code) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, code) return! FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) } |> Async.RunSynchronously @@ -429,7 +429,7 @@ module Test = () [] -let ``Automation.LetBindings.InModule``() = +let ``Automation.LetBindings.Module``() = let code = """ namespace FsTest @@ -444,7 +444,7 @@ module Test = () [] -let ``Automation.LetBindings.InClass``() = +let ``Automation.LetBindings.InsideType.Instance``() = let code = """ namespace FsTest @@ -459,7 +459,7 @@ module Test = StringAssert.StartsWith(expectedSignature, tooltip) [] -let ``Automation.LetBindings.StaticLet``() = +let ``Automation.LetBindings.InsideType.Static``() = let code = """ namespace FsTest @@ -475,7 +475,7 @@ module Test = () [] -let ``Automation.LetBindings.InDoBinding``() = +let ``Automation.LetBindings``() = let code = """ namespace FsTest @@ -485,11 +485,61 @@ module Test = () """ let expectedSignature = "val func: x: 'a -> unit" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for IWSAM property get``() = + let code = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticPr$$operty +""" + + let expectedSignature = "property IStaticProperty.StaticProperty: 'T with get" let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) +[] +let ``quick info for IWSAM method call``() = + let code = """ +type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = + static abstract StaticMethod: unit -> 'T + +let f (x: #IStaticMethod<'T>) = + 'T.StaticMe$$thod() +""" + + let expectedSignature = "static abstract IStaticMethod.StaticMethod: unit -> 'T" + let tooltip = GetQuickInfoTextFromCode code StringAssert.StartsWith(expectedSignature, tooltip) - () + +[] +let ``quick info for SRTP property get``() = + let code = """ + +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticPr$$operty +""" + + let expectedSignature = "'T: (static member StaticProperty: 'T)" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for SRTP method call``() = + let code = """ + +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticMethod: unit -> 'T) >() = + 'T.StaticMe$$thod() +""" + + let expectedSignature = "'T: (static member StaticMethod: unit -> 'T)" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + [] let ``Display names for exceptions with backticks preserve backticks``() = @@ -513,7 +563,7 @@ type R = {| ``thing wi$$th space``: string |} StringAssert.Contains(expected, actual) () - + [] let ``Display names identifiers for active patterns with backticks preserve backticks``() = let code = """ diff --git a/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs b/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs index 54a92f3cd0b..12132dc9acd 100644 --- a/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs +++ b/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework diff --git a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs index 78d0732493b..7b8d2825abe 100644 --- a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework @@ -33,7 +33,7 @@ type SemanticClassificationServiceTests() = let getRanges (source: string) : SemanticClassificationItem list = asyncMaybe { - let document, _ = RoslynTestHelpers.CreateDocument(filePath, source) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, source) let! _, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("SemanticClassificationServiceTests") |> liftAsync return checkFileResults.GetSemanticClassification(None) } diff --git a/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs b/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs index 7f173d259bc..805cd41c477 100644 --- a/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs +++ b/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs @@ -1,5 +1,5 @@ [] -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.SignatureHelpProvider +module VisualFSharp.UnitTests.Editor.SignatureHelpProvider open System open System.IO @@ -8,7 +8,7 @@ open NUnit.Framework open Microsoft.VisualStudio.FSharp.Editor -open VisualFSharp.UnitTests.Roslyn +open VisualFSharp.UnitTests.Editor open UnitTests.TestLib.LanguageService @@ -54,7 +54,7 @@ let GetSignatureHelp (project:FSharpProject) (fileName:string) (caretPosition:in let caretLinePos = textLines.GetLinePosition(caretPosition) let caretLineColumn = caretLinePos.Character - let document = RoslynTestHelpers.CreateDocument(fileName, sourceText, options = project.Options) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, sourceText, options = project.Options) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("GetSignatureHelp") |> Async.RunSynchronously @@ -101,7 +101,7 @@ let assertSignatureHelpForMethodCalls (fileContents: string) (marker: string) (e let caretLinePos = textLines.GetLinePosition(caretPosition) let caretLineColumn = caretLinePos.Character - let document = RoslynTestHelpers.CreateDocument(filePath, sourceText, options = projectOptions) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, sourceText, options = projectOptions) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("assertSignatureHelpForMethodCalls") |> Async.RunSynchronously @@ -132,7 +132,7 @@ let assertSignatureHelpForMethodCalls (fileContents: string) (marker: string) (e let assertSignatureHelpForFunctionApplication (fileContents: string) (marker: string) expectedArgumentCount expectedArgumentIndex expectedArgumentName = let caretPosition = fileContents.LastIndexOf(marker) + marker.Length - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("assertSignatureHelpForFunctionApplication") @@ -416,7 +416,7 @@ M.f let marker = "id " let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("function application in single pipeline with no additional args") diff --git a/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs index 05b0d39e7aa..3bb4245ee4d 100644 --- a/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs b/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs index 4387329518f..f7de265b87b 100644 --- a/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs +++ b/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs @@ -1,4 +1,4 @@ -namespace rec Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace rec VisualFSharp.UnitTests.Editor open System open System.IO @@ -16,6 +16,7 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.CodeAnalysis.Host.Mef open Microsoft.VisualStudio.LanguageServices open Microsoft.VisualStudio.Shell +open FSharp.Compiler.CodeAnalysis [] module MefHelpers = @@ -226,7 +227,7 @@ type RoslynTestHelpers private () = filePath = projFilePath ) - static member CreateDocument (filePath, text: SourceText, ?options: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions) = + static member CreateSingleDocumentSolution (filePath, text: SourceText, ?options: FSharpProjectOptions) = let isScript = String.Equals(Path.GetExtension(filePath), ".fsx", StringComparison.OrdinalIgnoreCase) let workspace = new AdhocWorkspace(TestHostServices()) @@ -272,7 +273,7 @@ type RoslynTestHelpers private () = document - static member CreateDocument (filePath, code: string) = + static member CreateSingleDocumentSolution (filePath, code: string, ?options) = let text = SourceText.From(code) - RoslynTestHelpers.CreateDocument(filePath, text), text + RoslynTestHelpers.CreateSingleDocumentSolution(filePath, text, ?options = options), text diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index 4caa4aa00f9..728d55383c2 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -61,57 +61,58 @@ CompilerService\UnusedOpensTests.fs - Roslyn\ProjectOptionsBuilder.fs + Editor\ProjectOptionsBuilder.fs - Roslyn\SyntacticColorizationServiceTests.fs + Editor\SyntacticColorizationServiceTests.fs - Roslyn\SemanticColorizationServiceTests.fs + Editor\SemanticColorizationServiceTests.fs - Roslyn\BraceMatchingServiceTests.fs + Editor\BraceMatchingServiceTests.fs - + Editor\EditorFormattingServiceTests.fs + + + Editor\RoslynSourceTextTests.fs - - Roslyn\IndentationServiceTests.fs + Editor\IndentationServiceTests.fs - Roslyn\BreakpointResolutionService.fs + Editor\BreakpointResolutionService.fs - Roslyn\LanguageDebugInfoServiceTests.fs + Editor\LanguageDebugInfoServiceTests.fs - Roslyn\DocumentDiagnosticAnalyzerTests.fs + Editor\DocumentDiagnosticAnalyzerTests.fs - Roslyn\CompletionProviderTests.fs + Editor\CompletionProviderTests.fs - Roslyn\FsxCompletionProviderTests.fs + Editor\FsxCompletionProviderTests.fs - Roslyn\SignatureHelpProviderTests.fs + Editor\SignatureHelpProviderTests.fs - Roslyn\QuickInfoTests.fs + Editor\QuickInfoTests.fs - Roslyn\GoToDefinitionServiceTests.fs + Editor\GoToDefinitionServiceTests.fs - Roslyn\QuickInfoProviderTests.fs + Editor\QuickInfoProviderTests.fs + + + Editor\HelpContextServiceTests.fs - Roslyn\DocumentHighlightsServiceTests.fs + Editor\DocumentHighlightsServiceTests.fs {{FSCoreVersion}} diff --git a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs index d13723b9697..3271017c0d9 100644 --- a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs +++ b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs @@ -18,7 +18,7 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.CodeAnalysis.Host.Mef open Microsoft.VisualStudio.LanguageServices open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +open VisualFSharp.UnitTests.Editor open NUnit.Framework []