diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md index 9798a50e6e3..de4626be28d 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -10,10 +10,11 @@ * Fix nullness inference for member val and other OO scenarios ([PR #17845](https://github.com/dotnet/fsharp/pull/17845)) * Fix internal error when analyzing incomplete inherit member ([PR #17905](https://github.com/dotnet/fsharp/pull/17905)) - ### Added + * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772)) * Support literal attribute on decimals ([PR #17769](https://github.com/dotnet/fsharp/pull/17769)) +* Added type conversions cache, only enabled for compiler runs, guarded by language version preview ([PR#17668](https://github.com/dotnet/fsharp/pull/17668)) ### Changed diff --git a/docs/release-notes/.Language/preview.md b/docs/release-notes/.Language/preview.md index a38e14215dc..48748215e02 100644 --- a/docs/release-notes/.Language/preview.md +++ b/docs/release-notes/.Language/preview.md @@ -2,6 +2,7 @@ * Better generic unmanaged structs handling. ([Language suggestion #692](https://github.com/fsharp/fslang-suggestions/issues/692), [PR #12154](https://github.com/dotnet/fsharp/pull/12154)) * Deprecate places where `seq` can be omitted. ([Language suggestion #1033](https://github.com/fsharp/fslang-suggestions/issues/1033), [PR #17772](https://github.com/dotnet/fsharp/pull/17772)) +* Added type conversions cache, only enabled for compiler runs ([PR#17668](https://github.com/dotnet/fsharp/pull/17668)) ### Fixed diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 9c14787d113..469dc213b17 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -43,6 +43,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations +open Import #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 24a2d5bbf6e..77fb623efb0 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -24,6 +24,7 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations +open Import /// Use the given function to select some of the member values from the members of an F# type let SelectImmediateMemberVals g optFilter f withExplicitImpl (tcref: TyconRef) = diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index b9eaa2c6687..18b3f23190f 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -107,6 +107,7 @@ exception TypeIsImplicitlyAbstract of range exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option * TcGlobals * Import.ImportMap * range module DispatchSlotChecking = + open Import /// Print the signature of an override to a buffer as part of an error message let PrintOverrideToBuffer denv os (Override(_, _, id, methTypars, memberToParentInst, argTys, retTy, _, _, _)) = diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 09e8708b894..62262b54635 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2045,7 +2045,7 @@ module TastDefinitionPrinting = (not vref.IsCompilerGenerated) && (denv.showObsoleteMembers || not (CheckFSharpAttributesForObsolete denv.g vref.Attribs)) && (denv.showHiddenMembers || not (CheckFSharpAttributesForHidden denv.g vref.Attribs)) - + let ctors = GetIntrinsicConstructorInfosOfType infoReader m ty |> List.filter (fun minfo -> IsMethInfoAccessible amap m ad minfo && not minfo.IsClassConstructor && shouldShow minfo.ArbitraryValRef) @@ -2057,7 +2057,7 @@ module TastDefinitionPrinting = tycon.ImmediateInterfacesOfFSharpTycon |> List.filter (fun (_, compgen, _) -> not compgen) |> List.map p13 - else + else GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty let iimplsLs = diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index b45f23407ea..00b25756801 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -24,6 +24,7 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypeRelations open type System.MemoryExtensions +open Import exception MatchIncomplete of bool * (string * bool) option * range exception RuleNeverMatched of range diff --git a/src/Compiler/Checking/SignatureHash.fs b/src/Compiler/Checking/SignatureHash.fs index 66aeb0912c7..a9bf8fce50e 100644 --- a/src/Compiler/Checking/SignatureHash.fs +++ b/src/Compiler/Checking/SignatureHash.fs @@ -1,340 +1,20 @@ module internal Fsharp.Compiler.SignatureHash -open Internal.Utilities.Library -open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals -open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.CheckDeclarations -type ObserverVisibility = - | PublicOnly - | PublicAndInternal - -[] -module internal HashingPrimitives = - - type Hash = int - - let inline hashText (s: string) : Hash = hash s - let inline private combineHash acc y : Hash = (acc <<< 1) + y + 631 - let inline pipeToHash (value: Hash) (acc: Hash) = combineHash acc value - let inline addFullStructuralHash (value) (acc: Hash) = combineHash (acc) (hash value) - - let inline hashListOrderMatters ([] func) (items: #seq<'T>) : Hash = - let mutable acc = 0 - - for i in items do - let valHash = func i - // We are calling hashListOrderMatters for things like list of types, list of properties, list of fields etc. The ones which are visibility-hidden will return 0, and are omitted. - if valHash <> 0 then - acc <- combineHash acc valHash - - acc - - let inline hashListOrderIndependent ([] func) (items: #seq<'T>) : Hash = - let mutable acc = 0 - - for i in items do - let valHash = func i - acc <- acc ^^^ valHash - - acc - - let (@@) (h1: Hash) (h2: Hash) = combineHash h1 h2 - -[] -module internal HashUtilities = - - let private hashEntityRefName (xref: EntityRef) name = - let tag = - if xref.IsNamespace then - TextTag.Namespace - elif xref.IsModule then - TextTag.Module - elif xref.IsTypeAbbrev then - TextTag.Alias - elif xref.IsFSharpDelegateTycon then - TextTag.Delegate - elif xref.IsILEnumTycon || xref.IsFSharpEnumTycon then - TextTag.Enum - elif xref.IsStructOrEnumTycon then - TextTag.Struct - elif isInterfaceTyconRef xref then - TextTag.Interface - elif xref.IsUnionTycon then - TextTag.Union - elif xref.IsRecordTycon then - TextTag.Record - else - TextTag.Class - - (hash tag) @@ (hashText name) - - let hashTyconRefImpl (tcref: TyconRef) = - let demangled = tcref.DisplayNameWithStaticParameters - let tyconHash = hashEntityRefName tcref demangled - - tcref.CompilationPath.AccessPath - |> hashListOrderMatters (fst >> hashText) - |> pipeToHash tyconHash - -module HashIL = - - let hashILTypeRef (tref: ILTypeRef) = - tref.Enclosing - |> hashListOrderMatters hashText - |> addFullStructuralHash tref.Name - - let private hashILArrayShape (sh: ILArrayShape) = sh.Rank - - let rec hashILType (ty: ILType) : Hash = - match ty with - | ILType.Void -> hash ILType.Void - | ILType.Array(sh, t) -> hashILType t @@ hashILArrayShape sh - | ILType.Value t - | ILType.Boxed t -> hashILTypeRef t.TypeRef @@ (t.GenericArgs |> hashListOrderMatters (hashILType)) - | ILType.Ptr t - | ILType.Byref t -> hashILType t - | ILType.FunctionPointer t -> hashILCallingSignature t - | ILType.TypeVar n -> hash n - | ILType.Modified(_, _, t) -> hashILType t - - and hashILCallingSignature (signature: ILCallingSignature) = - let res = signature.ReturnType |> hashILType - signature.ArgTypes |> hashListOrderMatters (hashILType) |> pipeToHash res - -module HashAccessibility = - - let isHiddenToObserver (TAccess access) (observer: ObserverVisibility) = - let isInternalCompPath x = - match x with - | CompPath(ILScopeRef.Local, _, []) -> true - | _ -> false - - match access with - | [] -> false - | _ when List.forall isInternalCompPath access -> - match observer with - // The 'access' means internal, but our observer can see it (e.g. because of IVT attribute) - | PublicAndInternal -> false - | PublicOnly -> true - | _ -> true - -module rec HashTypes = - - /// Hash a reference to a type - let hashTyconRef tcref = hashTyconRefImpl tcref - - /// Hash the flags of a member - let hashMemberFlags (memFlags: SynMemberFlags) = hash memFlags - - /// Hash an attribute 'Type(arg1, ..., argN)' - let private hashAttrib (Attrib(tyconRef = tcref)) = hashTyconRefImpl tcref - - let hashAttributeList attrs = - attrs |> hashListOrderIndependent hashAttrib - - let private hashTyparRef (typar: Typar) = - hashText typar.DisplayName - |> addFullStructuralHash (typar.Rigidity) - |> addFullStructuralHash (typar.StaticReq) - - let private hashTyparRefWithInfo (typar: Typar) = - hashTyparRef typar @@ hashAttributeList typar.Attribs - - let private hashConstraint (g: TcGlobals) struct (tp, tpc) = - let tpHash = hashTyparRefWithInfo tp - - match tpc with - | TyparConstraint.CoercesTo(tgtTy, _) -> tpHash @@ 1 @@ hashTType g tgtTy - | TyparConstraint.MayResolveMember(traitInfo, _) -> tpHash @@ 2 @@ hashTraitWithInfo (* denv *) g traitInfo - | TyparConstraint.DefaultsTo(_, ty, _) -> tpHash @@ 3 @@ hashTType g ty - | TyparConstraint.IsEnum(ty, _) -> tpHash @@ 4 @@ hashTType g ty - | TyparConstraint.SupportsComparison _ -> tpHash @@ 5 - | TyparConstraint.SupportsEquality _ -> tpHash @@ 6 - | TyparConstraint.IsDelegate(aty, bty, _) -> tpHash @@ 7 @@ hashTType g aty @@ hashTType g bty - | TyparConstraint.SupportsNull _ -> tpHash @@ 8 - | TyparConstraint.IsNonNullableStruct _ -> tpHash @@ 9 - | TyparConstraint.IsUnmanaged _ -> tpHash @@ 10 - | TyparConstraint.IsReferenceType _ -> tpHash @@ 11 - | TyparConstraint.SimpleChoice(tys, _) -> tpHash @@ 12 @@ (tys |> hashListOrderIndependent (hashTType g)) - | TyparConstraint.RequiresDefaultConstructor _ -> tpHash @@ 13 - | TyparConstraint.NotSupportsNull(_) -> tpHash @@ 14 - | TyparConstraint.AllowsRefStruct _ -> tpHash @@ 15 - - /// Hash type parameter constraints - let private hashConstraints (g: TcGlobals) cxs = - cxs |> hashListOrderIndependent (hashConstraint g) - - let private hashTraitWithInfo (g: TcGlobals) traitInfo = - let nameHash = hashText traitInfo.MemberLogicalName - let memberHash = hashMemberFlags traitInfo.MemberFlags - - let returnTypeHash = - match traitInfo.CompiledReturnType with - | Some t -> hashTType g t - | _ -> -1 - - traitInfo.CompiledObjectAndArgumentTypes - |> hashListOrderIndependent (hashTType g) - |> pipeToHash (nameHash) - |> pipeToHash (returnTypeHash) - |> pipeToHash memberHash - - /// Hash a unit of measure expression - let private hashMeasure unt = - let measuresWithExponents = - ListMeasureVarOccsWithNonZeroExponents unt - |> List.sortBy (fun (tp: Typar, _) -> tp.DisplayName) - - measuresWithExponents - |> hashListOrderIndependent (fun (typar, exp: Rational) -> hashTyparRef typar @@ hash exp) - - /// Hash a type, taking precedence into account to insert brackets where needed - let hashTType (g: TcGlobals) ty = - - match stripTyparEqns ty |> (stripTyEqns g) with - | TType_ucase(UnionCaseRef(tc, _), args) - | TType_app(tc, args, _) -> args |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTyconRef tc) - | TType_anon(anonInfo, tys) -> - tys - |> hashListOrderMatters (hashTType g) - |> pipeToHash (anonInfo.SortedNames |> hashListOrderMatters hashText) - |> addFullStructuralHash (evalAnonInfoIsStruct anonInfo) - | TType_tuple(tupInfo, t) -> - t - |> hashListOrderMatters (hashTType g) - |> addFullStructuralHash (evalTupInfoIsStruct tupInfo) - // Hash a first-class generic type. - | TType_forall(tps, tau) -> tps |> hashListOrderMatters (hashTyparRef) |> pipeToHash (hashTType g tau) - | TType_fun _ -> - let argTys, retTy = stripFunTy g ty - argTys |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTType g retTy) - | TType_var(r, _) -> hashTyparRefWithInfo r - | TType_measure unt -> hashMeasure unt - - // Hash a single argument, including its name and type - let private hashArgInfo (g: TcGlobals) (ty, argInfo: ArgReprInfo) = - - let attributesHash = hashAttributeList argInfo.Attribs - - let nameHash = - match argInfo.Name with - | Some i -> hashText i.idText - | _ -> -1 - - let typeHash = hashTType g ty - - typeHash @@ nameHash @@ attributesHash - - let private hashCurriedArgInfos (g: TcGlobals) argInfos = - argInfos - |> hashListOrderMatters (fun l -> l |> hashListOrderMatters (hashArgInfo g)) - - /// Hash a single type used as the type of a member or value - let hashTopType (g: TcGlobals) argInfos retTy cxs = - let retTypeHash = hashTType g retTy - let cxsHash = hashConstraints g cxs - let argHash = hashCurriedArgInfos g argInfos - - retTypeHash @@ cxsHash @@ argHash - - let private hashTyparInclConstraints (g: TcGlobals) (typar: Typar) = - typar.Constraints - |> hashListOrderIndependent (fun tpc -> hashConstraint g (typar, tpc)) - |> pipeToHash (hashTyparRef typar) - - /// Hash type parameters - let hashTyparDecls (g: TcGlobals) (typars: Typars) = - typars |> hashListOrderMatters (hashTyparInclConstraints g) - - let private hashUncurriedSig (g: TcGlobals) typarInst argInfos retTy = - typarInst - |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) - |> pipeToHash (hashTopType g argInfos retTy []) - - let private hashMemberSigCore (g: TcGlobals) memberToParentInst (typarInst, methTypars: Typars, argInfos, retTy) = - typarInst - |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) - |> pipeToHash (hashTopType g argInfos retTy []) - |> pipeToHash ( - memberToParentInst - |> hashListOrderMatters (fun (typar, ty) -> hashTyparRef typar @@ hashTType g ty) - ) - |> pipeToHash (hashTyparDecls g methTypars) - - let hashMemberType (g: TcGlobals) vref typarInst argInfos retTy = - match PartitionValRefTypars g vref with - | Some(_, _, memberMethodTypars, memberToParentInst, _) -> - hashMemberSigCore g memberToParentInst (typarInst, memberMethodTypars, argInfos, retTy) - | None -> hashUncurriedSig g typarInst argInfos retTy - -module HashTastMemberOrVals = - open HashTypes - - let private hashMember (g: TcGlobals, observer) typarInst (v: Val) = - let vref = mkLocalValRef v - - if HashAccessibility.isHiddenToObserver vref.Accessibility observer then - 0 - else - let membInfo = Option.get vref.MemberInfo - let _tps, argInfos, retTy, _ = GetTypeOfMemberInFSharpForm g vref - - let memberFlagsHash = hashMemberFlags membInfo.MemberFlags - let parentTypeHash = hashTyconRef membInfo.ApparentEnclosingEntity - let memberTypeHash = hashMemberType g vref typarInst argInfos retTy - let flagsHash = hash v.val_flags.PickledBits - let nameHash = hashText v.DisplayNameCoreMangled - let attribsHash = hashAttributeList v.Attribs - - let combinedHash = - memberFlagsHash - @@ parentTypeHash - @@ memberTypeHash - @@ flagsHash - @@ nameHash - @@ attribsHash - - combinedHash - - let private hashNonMemberVal (g: TcGlobals, observer) (tps, v: Val, tau, cxs) = - if HashAccessibility.isHiddenToObserver v.Accessibility observer then - 0 - else - let valReprInfo = arityOfValForDisplay v - let nameHash = hashText v.DisplayNameCoreMangled - let typarHash = hashTyparDecls g tps - let argInfos, retTy = GetTopTauTypeInFSharpForm g valReprInfo.ArgInfos tau v.Range - let typeHash = hashTopType g argInfos retTy cxs - let flagsHash = hash v.val_flags.PickledBits - let attribsHash = hashAttributeList v.Attribs - - let combinedHash = nameHash @@ typarHash @@ typeHash @@ flagsHash @@ attribsHash - combinedHash - - let hashValOrMemberNoInst (g, obs) (vref: ValRef) = - match vref.MemberInfo with - | None -> - let tps, tau = vref.GeneralizedType - - let cxs = - tps - |> Seq.collect (fun tp -> tp.Constraints |> Seq.map (fun cx -> struct (tp, cx))) - - hashNonMemberVal (g, obs) (tps, vref.Deref, tau, cxs) - | Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref +open Internal.Utilities.Library +open Internal.Utilities.TypeHashing +open Internal.Utilities.TypeHashing.HashTypes //------------------------------------------------------------------------- /// Printing TAST objects module TyconDefinitionHash = - open HashTypes let private hashRecdField (g: TcGlobals, observer) (fld: RecdField) = if HashAccessibility.isHiddenToObserver fld.Accessibility observer then diff --git a/src/Compiler/Checking/SignatureHash.fsi b/src/Compiler/Checking/SignatureHash.fsi index 90d25e8eabb..51f3fe17695 100644 --- a/src/Compiler/Checking/SignatureHash.fsi +++ b/src/Compiler/Checking/SignatureHash.fsi @@ -5,9 +5,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.CheckDeclarations -type ObserverVisibility = - | PublicOnly - | PublicAndInternal +open Internal.Utilities.TypeHashing val calculateHashOfImpliedSignature: g: TcGlobals -> observer: ObserverVisibility -> expr: ModuleOrNamespaceContents -> int diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index 498fd3e3bb8..6c38b68d80a 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -6,7 +6,8 @@ module internal FSharp.Compiler.TypeRelations open FSharp.Compiler.Features open Internal.Utilities.Collections -open Internal.Utilities.Library +open Internal.Utilities.Library + open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree @@ -14,38 +15,43 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy +open Import + +#nowarn "3391" + /// Implements a :> b without coercion based on finalized (no type variable) types -// Note: This relation is approximate and not part of the language specification. +// Note: This relation is approximate and not part of the language specification. // -// Some appropriate uses: +// Some appropriate uses: // patcompile.fs: IsDiscrimSubsumedBy (approximate warning for redundancy of 'isinst' patterns) // tc.fs: TcRuntimeTypeTest (approximate warning for redundant runtime type tests) // tc.fs: TcExnDefnCore (error for bad exception abbreviation) // ilxgen.fs: GenCoerce (omit unnecessary castclass or isinst instruction) // -let rec TypeDefinitelySubsumesTypeNoCoercion ndeep g amap m ty1 ty2 = - if ndeep > 100 then error(InternalError("recursive class hierarchy (detected in TypeDefinitelySubsumesTypeNoCoercion), ty1 = " + (DebugPrint.showType ty1), m)) - if ty1 === ty2 then true - elif typeEquiv g ty1 ty2 then true - else - let ty1 = stripTyEqns g ty1 - let ty2 = stripTyEqns g ty2 - // F# reference types are subtypes of type 'obj' - (typeEquiv g ty1 g.obj_ty_ambivalent && isRefTy g ty2) || - // Follow the supertype chain - (isAppTy g ty2 && - isRefTy g ty2 && +let rec TypeDefinitelySubsumesTypeNoCoercion ndeep g amap m ty1 ty2 = + + if ndeep > 100 then + error(InternalError("Large class hierarchy (possibly recursive, detected in TypeDefinitelySubsumesTypeNoCoercion), ty1 = " + (DebugPrint.showType ty1), m)) - ((match GetSuperTypeOfType g amap m ty2 with - | None -> false - | Some ty -> TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1 ty) || + if ty1 === ty2 then true + elif typeEquiv g ty1 ty2 then true + else + let ty1 = stripTyEqns g ty1 + let ty2 = stripTyEqns g ty2 + // F# reference types are subtypes of type 'obj' + (typeEquiv g ty1 g.obj_ty_ambivalent && isRefTy g ty2) || + // Follow the supertype chain + (isAppTy g ty2 && + isRefTy g ty2 && - // Follow the interface hierarchy - (isInterfaceTy g ty1 && - ty2 |> GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m - |> List.exists (TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1)))) + ((match GetSuperTypeOfType g amap m ty2 with + | None -> false + | Some ty -> TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1 ty) || -type CanCoerce = CanCoerce | NoCoerce + // Follow the interface hierarchy + (isInterfaceTy g ty1 && + ty2 |> GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m + |> List.exists (TypeDefinitelySubsumesTypeNoCoercion (ndeep+1) g amap m ty1)))) let stripAll stripMeasures g ty = if stripMeasures then @@ -54,80 +60,111 @@ let stripAll stripMeasures g ty = ty |> stripTyEqns g /// The feasible equivalence relation. Part of the language spec. -let rec TypesFeasiblyEquivalent stripMeasures ndeep g amap m ty1 ty2 = +let rec TypesFeasiblyEquivalent stripMeasures ndeep g amap m ty1 ty2 = - if ndeep > 100 then error(InternalError("recursive class hierarchy (detected in TypeFeasiblySubsumesType), ty1 = " + (DebugPrint.showType ty1), m)); + if ndeep > 100 then + error(InternalError("Large class hierarchy (possibly recursive, detected in TypeFeasiblySubsumesType), ty1 = " + (DebugPrint.showType ty1), m)); let ty1 = stripAll stripMeasures g ty1 let ty2 = stripAll stripMeasures g ty2 match ty1, ty2 with - | TType_var _, _ + | TType_measure _, TType_measure _ + | TType_var _, _ | _, TType_var _ -> true | TType_app (tcref1, l1, _), TType_app (tcref2, l2, _) when tyconRefEq g tcref1 tcref2 -> List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2 - | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> + | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> (evalTupInfoIsStruct anonInfo1.TupInfo = evalTupInfoIsStruct anonInfo2.TupInfo) && (match anonInfo1.Assembly, anonInfo2.Assembly with ccu1, ccu2 -> ccuEq ccu1 ccu2) && (anonInfo1.SortedNames = anonInfo2.SortedNames) && List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2 - | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && - List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2 + List.lengthsEqAndForall2 (TypesFeasiblyEquivalent stripMeasures ndeep g amap m) l1 l2 - | TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) -> + | TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) -> TypesFeasiblyEquivalent stripMeasures ndeep g amap m domainTy1 domainTy2 && TypesFeasiblyEquivalent stripMeasures ndeep g amap m rangeTy1 rangeTy2 - | TType_measure _, TType_measure _ -> - true - - | _ -> + | _ -> false /// The feasible equivalence relation. Part of the language spec. -let rec TypesFeasiblyEquiv ndeep g amap m ty1 ty2 = +let TypesFeasiblyEquiv ndeep g amap m ty1 ty2 = TypesFeasiblyEquivalent false ndeep g amap m ty1 ty2 /// The feasible equivalence relation after stripping Measures. let TypesFeasiblyEquivStripMeasures g amap m ty1 ty2 = TypesFeasiblyEquivalent true 0 g amap m ty1 ty2 +let inline TryGetCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key = + if g.compilationMode = CompilationMode.OneOff && g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then + match amap.TypeSubsumptionCache.TryGetValue(key) with + | true, subsumes -> + ValueSome subsumes + | false, _ -> + ValueNone + else + ValueNone + +let inline UpdateCachedTypeSubsumption (g: TcGlobals) (amap: ImportMap) key subsumes : unit = + if g.compilationMode = CompilationMode.OneOff && g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then + amap.TypeSubsumptionCache[key] <- subsumes + /// The feasible coercion relation. Part of the language spec. -let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = - if ndeep > 100 then error(InternalError("recursive class hierarchy (detected in TypeFeasiblySubsumesType), ty1 = " + (DebugPrint.showType ty1), m)) - let ty1 = stripTyEqns g ty1 - let ty2 = stripTyEqns g ty2 - match ty1, ty2 with - | TType_var _, _ | _, TType_var _ -> true +let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1: TType) (canCoerce: CanCoerce) (ty2: TType) = - | TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> - List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 + if ndeep > 100 then + error(InternalError("Large class hierarchy (possibly recursive, detected in TypeFeasiblySubsumesType), ty1 = " + (DebugPrint.showType ty1), m)) - | TType_tuple _, TType_tuple _ - | TType_anon _, TType_anon _ - | TType_fun _, TType_fun _ -> - TypesFeasiblyEquiv ndeep g amap m ty1 ty2 + let ty1 = stripTyEqns g ty1 + let ty2 = stripTyEqns g ty2 - | TType_measure _, TType_measure _ -> - true + // Check if language feature supported + let key = TTypeCacheKey.FromStrippedTypes (ty1, ty2, canCoerce, g) + + match TryGetCachedTypeSubsumption g amap key with + | ValueSome subsumes -> + subsumes + | ValueNone -> + let subsumes = + match ty1, ty2 with + | TType_measure _, TType_measure _ + | TType_var _, _ | _, TType_var _ -> + true + + | TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> + List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 + + | TType_tuple _, TType_tuple _ + | TType_anon _, TType_anon _ + | TType_fun _, TType_fun _ -> + TypesFeasiblyEquiv ndeep g amap m ty1 ty2 + + | _ -> + // F# reference types are subtypes of type 'obj' + if isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2) then + true + elif isAppTy g ty2 && (canCoerce = CanCoerce || isRefTy g ty2) && TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 then + true + else + let interfaces = GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2 + // See if any interface in type hierarchy of ty2 is a supertype of ty1 + List.exists (TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce) interfaces + + UpdateCachedTypeSubsumption g amap key subsumes + + subsumes + +and TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 = + match GetSuperTypeOfType g amap m ty2 with + | None -> false + | Some ty -> TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce ty - | _ -> - // F# reference types are subtypes of type 'obj' - (isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2)) - || - (isAppTy g ty2 && - (canCoerce = CanCoerce || isRefTy g ty2) && - begin match GetSuperTypeOfType g amap m ty2 with - | None -> false - | Some ty -> TypeFeasiblySubsumesType (ndeep+1) g amap m ty1 NoCoerce ty - end || - ty2 |> GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m - |> List.exists (TypeFeasiblySubsumesType (ndeep+1) g amap m ty1 NoCoerce)) - /// Choose solutions for Expr.TyChoose type "hidden" variables introduced /// by letrec nodes. Also used by the pattern match compiler to choose type /// variables when compiling patterns at generalized bindings. @@ -136,35 +173,35 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = let m = tp.Range let (maxTy, isRefined), m = - let initialTy = - match tp.Kind with + let initialTy = + match tp.Kind with | TyparKind.Type -> g.obj_ty_noNulls | TyparKind.Measure -> TType_measure Measure.One // Loop through the constraints computing the lub (((initialTy, false), m), tp.Constraints) ||> List.fold (fun ((maxTy, isRefined), _) tpc -> - let join m x = + let join m x = if TypeFeasiblySubsumesType 0 g amap m x CanCoerce maxTy then maxTy, isRefined elif TypeFeasiblySubsumesType 0 g amap m maxTy CanCoerce x then x, true else errorR(Error(FSComp.SR.typrelCannotResolveImplicitGenericInstantiation((DebugPrint.showType x), (DebugPrint.showType maxTy)), m)); maxTy, isRefined - // Don't continue if an error occurred and we set the value eagerly + // Don't continue if an error occurred and we set the value eagerly if tp.IsSolved then (maxTy, isRefined), m else - match tpc with - | TyparConstraint.CoercesTo(x, m) -> + match tpc with + | TyparConstraint.CoercesTo(x, m) -> join m x, m | TyparConstraint.SimpleChoice(_, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInPrintf(), m)) (maxTy, isRefined), m - | TyparConstraint.SupportsNull m -> + | TyparConstraint.SupportsNull m -> ((addNullnessToTy KnownWithNull maxTy), isRefined), m | TyparConstraint.SupportsComparison m -> join m g.mk_IComparable_ty, m | TyparConstraint.IsEnum(_, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInEnum(), m)) (maxTy, isRefined), m - | TyparConstraint.IsDelegate(_, _, m) -> + | TyparConstraint.IsDelegate(_, _, m) -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInDelegate(), m)) (maxTy, isRefined), m - | TyparConstraint.IsNonNullableStruct m -> + | TyparConstraint.IsNonNullableStruct m -> join m g.int_ty, m | TyparConstraint.IsUnmanaged m -> errorR(Error(FSComp.SR.typrelCannotResolveAmbiguityInUnmanaged(), m)) @@ -175,7 +212,7 @@ let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = | TyparConstraint.RequiresDefaultConstructor m | TyparConstraint.IsReferenceType m | TyparConstraint.MayResolveMember(_, m) - | TyparConstraint.DefaultsTo(_,_, m) -> + | TyparConstraint.DefaultsTo(_,_, m) -> (maxTy, isRefined), m ) @@ -188,7 +225,7 @@ let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = maxTy, m -let ChooseTyparSolution g amap tp = +let ChooseTyparSolution g amap tp = let ty, _m = ChooseTyparSolutionAndRange g amap tp if tp.Rigidity = TyparRigidity.Anon && typeEquiv g ty (TType_measure Measure.One) then warning(Error(FSComp.SR.csCodeLessGeneric(), tp.Range)) @@ -198,14 +235,14 @@ let ChooseTyparSolution g amap tp = // For example // 'a = Expr<'b> // 'b = int -// In this case the solutions are +// In this case the solutions are // 'a = Expr // 'b = int // We ground out the solutions by repeatedly instantiating -let IterativelySubstituteTyparSolutions g tps solutions = +let IterativelySubstituteTyparSolutions g tps solutions = let tpenv = mkTyparInst tps solutions - let rec loop n curr = - let curr' = curr |> instTypes tpenv + let rec loop n curr = + let curr' = curr |> instTypes tpenv // We cut out at n > 40 just in case this loops. It shouldn't, since there should be no cycles in the // solution equations, and we've only ever seen one example where even n = 2 was required. // Perhaps it's possible in error recovery some strange situations could occur where cycles @@ -213,25 +250,25 @@ let IterativelySubstituteTyparSolutions g tps solutions = // // We don't give an error if we hit the limit since it's feasible that the solutions of unknowns // is not actually relevant to the rest of type checking or compilation. - if n > 40 || List.forall2 (typeEquiv g) curr curr' then - curr - else + if n > 40 || List.forall2 (typeEquiv g) curr curr' then + curr + else loop (n+1) curr' loop 0 solutions -let ChooseTyparSolutionsForFreeChoiceTypars g amap e = - match stripDebugPoints e with - | Expr.TyChoose (tps, e1, _m) -> - - /// Only make choices for variables that are actually used in the expression +let ChooseTyparSolutionsForFreeChoiceTypars g amap e = + match stripDebugPoints e with + | Expr.TyChoose (tps, e1, _m) -> + + /// Only make choices for variables that are actually used in the expression let ftvs = (freeInExpr CollectTyparsNoCaching e1).FreeTyvars.FreeTypars let tps = tps |> List.filter (Zset.memberOf ftvs) - + let solutions = tps |> List.map (ChooseTyparSolution g amap) |> IterativelySubstituteTyparSolutions g tps - + let tpenv = mkTyparInst tps solutions - + instExpr g tpenv e1 | _ -> e @@ -241,51 +278,51 @@ let ChooseTyparSolutionsForFreeChoiceTypars g amap e = /// PostTypeCheckSemanticChecks before we've eliminated these nodes. let tryDestLambdaWithValReprInfo g amap valReprInfo (lambdaExpr, ty) = let (ValReprInfo (tpNames, _, _)) = valReprInfo - let rec stripLambdaUpto n (e, ty) = - match stripDebugPoints e with - | Expr.Lambda (_, None, None, v, b, _, retTy) when n > 0 -> + let rec stripLambdaUpto n (e, ty) = + match stripDebugPoints e with + | Expr.Lambda (_, None, None, v, b, _, retTy) when n > 0 -> let vs', b', retTy' = stripLambdaUpto (n-1) (b, retTy) - (v :: vs', b', retTy') - | _ -> + (v :: vs', b', retTy') + | _ -> ([], e, ty) - let rec startStripLambdaUpto n (e, ty) = - match stripDebugPoints e with - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, b, _, retTy) when n > 0 -> + let rec startStripLambdaUpto n (e, ty) = + match stripDebugPoints e with + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, b, _, retTy) when n > 0 -> let vs', b', retTy' = stripLambdaUpto (n-1) (b, retTy) - (ctorThisValOpt, baseValOpt, (v :: vs'), b', retTy') - | Expr.TyChoose (_tps, _b, _) -> + (ctorThisValOpt, baseValOpt, (v :: vs'), b', retTy') + | Expr.TyChoose (_tps, _b, _) -> startStripLambdaUpto n (ChooseTyparSolutionsForFreeChoiceTypars g amap e, ty) - | _ -> + | _ -> (None, None, [], e, ty) let n = valReprInfo.NumCurriedArgs - let tps, bodyExpr, bodyTy = - match stripDebugPoints lambdaExpr with - | Expr.TyLambda (_, tps, b, _, retTy) when not (isNil tpNames) -> tps, b, retTy + let tps, bodyExpr, bodyTy = + match stripDebugPoints lambdaExpr with + | Expr.TyLambda (_, tps, b, _, retTy) when not (isNil tpNames) -> tps, b, retTy | _ -> [], lambdaExpr, ty let ctorThisValOpt, baseValOpt, vsl, body, retTy = startStripLambdaUpto n (bodyExpr, bodyTy) - if vsl.Length <> n then - None + if vsl.Length <> n then + None else Some (tps, ctorThisValOpt, baseValOpt, vsl, body, retTy) -let destLambdaWithValReprInfo g amap valReprInfo (lambdaExpr, ty) = - match tryDestLambdaWithValReprInfo g amap valReprInfo (lambdaExpr, ty) with +let destLambdaWithValReprInfo g amap valReprInfo (lambdaExpr, ty) = + match tryDestLambdaWithValReprInfo g amap valReprInfo (lambdaExpr, ty) with | None -> error(Error(FSComp.SR.typrelInvalidValue(), lambdaExpr.Range)) | Some res -> res - + let IteratedAdjustArityOfLambdaBody g arities vsl body = - (arities, vsl, ([], body)) |||> List.foldBack2 (fun arities vs (allvs, body) -> + (arities, vsl, ([], body)) |||> List.foldBack2 (fun arities vs (allvs, body) -> let vs, body = AdjustArityOfLambdaBody g arities vs body vs :: allvs, body) -/// Do IteratedAdjustArityOfLambdaBody for a series of iterated lambdas, producing one method. -/// The required iterated function arity (List.length valReprInfo) must be identical -/// to the iterated function arity of the input lambda (List.length vsl) +/// Do IteratedAdjustArityOfLambdaBody for a series of iterated lambdas, producing one method. +/// The required iterated function arity (List.length valReprInfo) must be identical +/// to the iterated function arity of the input lambda (List.length vsl) let IteratedAdjustLambdaToMatchValReprInfo g amap valReprInfo lambdaExpr = let lambdaExprTy = tyOfExpr g lambdaExpr @@ -294,7 +331,7 @@ let IteratedAdjustLambdaToMatchValReprInfo g amap valReprInfo lambdaExpr = let arities = valReprInfo.AritiesOfArgs - if arities.Length <> vsl.Length then + if arities.Length <> vsl.Length then errorR(InternalError(sprintf "IteratedAdjustLambdaToMatchValReprInfo, #arities = %d, #vsl = %d" arities.Length vsl.Length, body.Range)) let vsl, body = IteratedAdjustArityOfLambdaBody g arities vsl body @@ -303,6 +340,6 @@ let IteratedAdjustLambdaToMatchValReprInfo g amap valReprInfo lambdaExpr = /// "Single Feasible Type" inference /// Look for the unique supertype of ty2 for which ty2 :> ty1 might feasibly hold -let FindUniqueFeasibleSupertype g amap m ty1 ty2 = +let FindUniqueFeasibleSupertype g amap m ty1 ty2 = let supertypes = Option.toList (GetSuperTypeOfType g amap m ty2) @ (GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2) - supertypes |> List.tryFind (TypeFeasiblySubsumesType 0 g amap m ty1 NoCoerce) + supertypes |> List.tryFind (TypeFeasiblySubsumesType 0 g amap m ty1 NoCoerce) diff --git a/src/Compiler/Checking/TypeRelations.fsi b/src/Compiler/Checking/TypeRelations.fsi index b33852fae53..9419e617d70 100644 --- a/src/Compiler/Checking/TypeRelations.fsi +++ b/src/Compiler/Checking/TypeRelations.fsi @@ -9,10 +9,6 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree -type CanCoerce = - | CanCoerce - | NoCoerce - /// Implements a :> b without coercion based on finalized (no type variable) types val TypeDefinitelySubsumesTypeNoCoercion: ndeep: int -> g: TcGlobals -> amap: ImportMap -> m: range -> ty1: TType -> ty2: TType -> bool diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 1c1b0ed9ea1..a1deee1c8a1 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -8,7 +8,9 @@ open System.Collections.Generic open System.Collections.Immutable open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler +open Internal.Utilities.TypeHashing +open Internal.Utilities.TypeHashing.HashTypes +open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DiagnosticsLogger @@ -24,9 +26,9 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypeProviders #endif -/// Represents an interface to some of the functionality of TcImports, for loading assemblies +/// Represents an interface to some of the functionality of TcImports, for loading assemblies /// and accessing information about generated provided assemblies. -type AssemblyLoader = +type AssemblyLoader = /// Resolve an Abstract IL assembly reference to a Ccu abstract FindCcuFromAssemblyRef : CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult @@ -43,48 +45,95 @@ type AssemblyLoader = /// Record a root for a [] type to help guide static linking & type relocation abstract RecordGeneratedTypeRoot : ProviderGeneratedType -> unit #endif - + +[] +type CanCoerce = + | CanCoerce + | NoCoerce + +type [] TTypeCacheKey = + + val ty1: TType + val ty2: TType + val canCoerce: CanCoerce + val tcGlobals: TcGlobals + + private new (ty1, ty2, canCoerce, tcGlobals) = + { ty1 = ty1; ty2 = ty2; canCoerce = canCoerce; tcGlobals = tcGlobals } + + static member FromStrippedTypes (ty1, ty2, canCoerce, tcGlobals) = + TTypeCacheKey(ty1, ty2, canCoerce, tcGlobals) + + interface System.IEquatable with + member this.Equals other = + if this.canCoerce <> other.canCoerce then + false + elif this.ty1 === other.ty1 && this.ty2 === other.ty2 then + true + else + stampEquals this.tcGlobals this.ty1 other.ty1 + && stampEquals this.tcGlobals this.ty2 other.ty2 + + override this.Equals other = + match other with + | :? TTypeCacheKey as p -> (this :> System.IEquatable).Equals p + | _ -> false + + override this.GetHashCode() : int = + let g = this.tcGlobals + + let ty1Hash = combineHash (hashStamp g this.ty1) (hashTType g this.ty1) + let ty2Hash = combineHash (hashStamp g this.ty2) (hashTType g this.ty2) + + let combined = combineHash (combineHash ty1Hash ty2Hash) (hash this.canCoerce) + + combined + //------------------------------------------------------------------------- // Import an IL types as F# types. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -/// Represents a context used by the import routines that convert AbstractIL types and provided -/// types to F# internal compiler data structures. +/// Represents a context used by the import routines that convert AbstractIL types and provided +/// types to F# internal compiler data structures. /// /// Also caches the conversion of AbstractIL ILTypeRef nodes, based on hashes of these. /// /// There is normally only one ImportMap for any assembly compilation, though additional instances can be created -/// using tcImports.GetImportMap() if needed, and it is not harmful if multiple instances are used. The object -/// serves as an interface through to the tables stored in the primary TcImports structures defined in CompileOps.fs. +/// using tcImports.GetImportMap() if needed, and it is not harmful if multiple instances are used. The object +/// serves as an interface through to the tables stored in the primary TcImports structures defined in CompileOps.fs. [] type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) = let typeRefToTyconRefCache = ConcurrentDictionary() + let typeSubsumptionCache = ConcurrentDictionary(System.Environment.ProcessorCount, 1024) + member _.g = g member _.assemblyLoader = assemblyLoader member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache -let CanImportILScopeRef (env: ImportMap) m scoref = + member _.TypeSubsumptionCache = typeSubsumptionCache + +let CanImportILScopeRef (env: ImportMap) m scoref = let isResolved assemblyRef = // Explanation: This represents an unchecked invariant in the hosted compiler: that any operations // which import types (and resolve assemblies from the tcImports tables) happen on the compilation thread. - let ctok = AssumeCompilationThreadWithoutEvidence() - + let ctok = AssumeCompilationThreadWithoutEvidence() + match env.assemblyLoader.FindCcuFromAssemblyRef (ctok, m, assemblyRef) with | UnresolvedCcu _ -> false | ResolvedCcu _ -> true - match scoref with + match scoref with | ILScopeRef.Local | ILScopeRef.Module _ -> true | ILScopeRef.Assembly assemblyRef -> isResolved assemblyRef | ILScopeRef.PrimaryAssembly -> isResolved env.g.ilg.primaryAssemblyRef /// Import a reference to a type definition, given the AbstractIL data for the type reference -let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) = +let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) = let findCcu assemblyRef = // Explanation: This represents an unchecked invariant in the hosted compiler: that any operations @@ -93,8 +142,8 @@ let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) = env.assemblyLoader.FindCcuFromAssemblyRef (ctok, m, assemblyRef) - let ccu = - match scoref with + let ccu = + match scoref with | ILScopeRef.Local -> error(InternalError("ImportILTypeRef: unexpected local scope", m)) | ILScopeRef.Module _ -> error(InternalError("ImportILTypeRef: reference found to a type in an auxiliary module", m)) | ILScopeRef.Assembly assemblyRef -> findCcu assemblyRef @@ -102,14 +151,14 @@ let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) = // Do a dereference of a fake tcref for the type just to check it exists in the target assembly and to find // the corresponding Tycon. - let ccu = + let ccu = match ccu with | ResolvedCcu ccu->ccu - | UnresolvedCcu ccuName -> + | UnresolvedCcu ccuName -> error (Error(FSComp.SR.impTypeRequiredUnavailable(typeName, ccuName), m)) let fakeTyconRef = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) typeName - let tycon = - try + let tycon = + try fakeTyconRef.Deref with _ -> error (Error(FSComp.SR.impReferencedTypeCouldNotBeFoundInAssembly(String.concat "." (Array.append path [| typeName |]), ccu.AssemblyName), m)) @@ -119,33 +168,33 @@ let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) = | TProvidedTypeRepr info -> //printfn "ImportTypeRefData: validating type: typeLogicalName = %A" typeName ValidateProvidedTypeAfterStaticInstantiation(m, info.ProvidedType, path, typeName) - | _ -> + | _ -> () #endif - match tryRescopeEntity ccu tycon with + match tryRescopeEntity ccu tycon with | ValueNone -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])), m)) | ValueSome tcref -> tcref - + /// Import a reference to a type definition, given an AbstractIL ILTypeRef, without caching // // Note, the type names that flow to the point include the "mangled" type names used for static parameters for provided types. // For example, // Foo.Bar,"1.0" -// This is because ImportProvidedType goes via Abstract IL type references. -let ImportILTypeRefUncached (env: ImportMap) m (tref: ILTypeRef) = - let path, typeName = - match tref.Enclosing with - | [] -> +// This is because ImportProvidedType goes via Abstract IL type references. +let ImportILTypeRefUncached (env: ImportMap) m (tref: ILTypeRef) = + let path, typeName = + match tref.Enclosing with + | [] -> splitILTypeNameWithPossibleStaticArguments tref.Name - | h :: t -> + | h :: t -> let nsp, tname = splitILTypeNameWithPossibleStaticArguments h // Note, subsequent type names do not need to be split, only the first [| yield! nsp; yield tname; yield! t |], tref.Name ImportTypeRefData (env: ImportMap) m (tref.Scope, path, typeName) - + /// Import a reference to a type definition, given an AbstractIL ILTypeRef, with caching let ImportILTypeRef (env: ImportMap) m (tref: ILTypeRef) = match env.ILTypeRefToTyconRefCache.TryGetValue tref with @@ -160,10 +209,10 @@ let CanImportILTypeRef (env: ImportMap) m (tref: ILTypeRef) = env.ILTypeRefToTyconRefCache.ContainsKey(tref) || CanImportILScopeRef env m tref.Scope /// Import a type, given an AbstractIL ILTypeRef and an F# type instantiation. -/// -/// Prefer the F# abbreviation for some built-in types, e.g. 'string' rather than -/// 'System.String', since we prefer the F# abbreviation to the .NET equivalents. -let ImportTyconRefApp (env: ImportMap) tcref tyargs nullness = +/// +/// Prefer the F# abbreviation for some built-in types, e.g. 'string' rather than +/// 'System.String', since we prefer the F# abbreviation to the .NET equivalents. +let ImportTyconRefApp (env: ImportMap) tcref tyargs nullness = env.g.improveType tcref tyargs nullness @@ -179,7 +228,7 @@ module Nullness = let knownWithoutNull = NullnessInfo.WithoutNull |> Nullness.Known let knownNullable = NullnessInfo.WithNull |> Nullness.Known - let mapping byteValue = + let mapping byteValue = match byteValue with | 0uy -> knownAmbivalent | 1uy -> knownWithoutNull @@ -187,36 +236,36 @@ module Nullness = | _ -> dprintfn "%i was passed to Nullness mapping, this is not a valid value" byteValue knownAmbivalent - + let isByte (g:TcGlobals) (ilgType:ILType) = g.ilg.typ_Byte.BasicQualifiedName = ilgType.BasicQualifiedName - let tryParseAttributeDataToNullableByteFlags (g:TcGlobals) attrData = + let tryParseAttributeDataToNullableByteFlags (g:TcGlobals) attrData = match attrData with | None -> ValueNone | Some ([ILAttribElem.Byte 0uy],_) -> ValueSome arrayWithByte0 | Some ([ILAttribElem.Byte 1uy],_) -> ValueSome arrayWithByte1 | Some ([ILAttribElem.Byte 2uy],_) -> ValueSome arrayWithByte2 - | Some ([ILAttribElem.Array(byteType,listOfBytes)],_) when isByte g byteType -> + | Some ([ILAttribElem.Array(byteType,listOfBytes)],_) when isByte g byteType -> listOfBytes |> Array.ofList |> Array.choose(function | ILAttribElem.Byte b -> Some b | _ -> None) |> ValueSome - + | _ -> ValueNone [] type AttributesFromIL = AttributesFromIL of metadataIndex:int * attrs:ILAttributesStored - with + with member this.Read() = match this with| AttributesFromIL(idx,attrs) -> attrs.GetCustomAttrs(idx) - member this.GetNullable(g:TcGlobals) = + member this.GetNullable(g:TcGlobals) = match g.attrib_NullableAttribute_opt with | None -> ValueNone | Some n -> TryDecodeILAttribute n.TypeRef (this.Read()) |> tryParseAttributeDataToNullableByteFlags g - member this.GetNullableContext(g:TcGlobals) = + member this.GetNullableContext(g:TcGlobals) = match g.attrib_NullableContextAttribute_opt with | None -> ValueNone | Some n -> @@ -224,7 +273,7 @@ module Nullness = |> tryParseAttributeDataToNullableByteFlags g [] - type NullableContextSource = + type NullableContextSource = | FromClass of AttributesFromIL | FromMethodAndClass of methodAttrs:AttributesFromIL * classAttrs:AttributesFromIL @@ -233,17 +282,17 @@ module Nullness = { DirectAttributes: AttributesFromIL Fallback : NullableContextSource} with - member this.GetFlags(g:TcGlobals) = + member this.GetFlags(g:TcGlobals) = let fallback = this.Fallback this.DirectAttributes.GetNullable(g) - |> ValueOption.orElseWith(fun () -> + |> ValueOption.orElseWith(fun () -> match fallback with | FromClass attrs -> attrs.GetNullableContext(g) - | FromMethodAndClass(methodCtx,classCtx) -> + | FromMethodAndClass(methodCtx,classCtx) -> methodCtx.GetNullableContext(g) |> ValueOption.orElseWith (fun () -> classCtx.GetNullableContext(g))) |> ValueOption.defaultValue arrayWithByte0 - static member Empty = + static member Empty = let emptyFromIL = AttributesFromIL(0,Given(ILAttributes.Empty)) {DirectAttributes = emptyFromIL; Fallback = FromClass(emptyFromIL)} @@ -256,16 +305,16 @@ The array is passed trough all generic typars depth first , e.g. List we cannot tell - | 0 -> knownAmbivalent + | 0 -> knownAmbivalent // A scalar value from attributes, cover type and all it's potential typars | 1 -> this.Data[0] |> mapping // We have a bigger array, indexes map to typars in a depth-first fashion | n when n > this.Idx -> this.Data[this.Idx] |> mapping // This is an erroneous case, we need more nullnessinfo then the metadata contains - | _ -> + | _ -> // TODO nullness - once being confident that our bugs are solved and what remains are incoming metadata bugs, remove failwith and replace with dprintfn // Testing with .NET compilers other then Roslyn producing nullness metadata? failwithf "Length of Nullable metadata and needs of its processing do not match: %A" this @@ -273,13 +322,13 @@ For value types, a value is passed even though it is always 0 member this.Advance() = {Data = this.Data; Idx = this.Idx + 1} - let inline isSystemNullable (tspec:ILTypeSpec) = + let inline isSystemNullable (tspec:ILTypeSpec) = match tspec.Name,tspec.Enclosing with | "Nullable`1",["System"] -> true | "System.Nullable`1",[] -> true | _ -> false - let inline evaluateFirstOrderNullnessAndAdvance (ilt:ILType) (flags:NullableFlags) = + let inline evaluateFirstOrderNullnessAndAdvance (ilt:ILType) (flags:NullableFlags) = match ilt with | ILType.Value tspec when tspec.GenericArgs.IsEmpty -> KnownWithoutNull, flags // System.Nullable is special-cased in C# spec for nullness metadata. @@ -289,93 +338,93 @@ For value types, a value is passed even though it is always 0 | _ -> flags.GetNullness(), flags.Advance() /// Import an IL type as an F# type. -let rec ImportILType (env: ImportMap) m tinst ty = +let rec ImportILType (env: ImportMap) m tinst ty = match ty with - | ILType.Void -> + | ILType.Void -> env.g.unit_ty - | ILType.Array(bounds, ty) -> + | ILType.Array(bounds, ty) -> let n = bounds.Rank - let elemTy = ImportILType env m tinst ty + let elemTy = ImportILType env m tinst ty mkArrayTy env.g n Nullness.knownAmbivalent elemTy m | ILType.Boxed tspec | ILType.Value tspec -> - let tcref = ImportILTypeRef env m tspec.TypeRef - let inst = tspec.GenericArgs |> List.map (ImportILType env m tinst) + let tcref = ImportILTypeRef env m tspec.TypeRef + let inst = tspec.GenericArgs |> List.map (ImportILType env m tinst) ImportTyconRefApp env tcref inst Nullness.knownAmbivalent | ILType.Byref ty -> mkByrefTy env.g (ImportILType env m tinst ty) | ILType.Ptr ILType.Void when env.g.voidptr_tcr.CanDeref -> mkVoidPtrTy env.g | ILType.Ptr ty -> mkNativePtrTy env.g (ImportILType env m tinst ty) | ILType.FunctionPointer _ -> env.g.nativeint_ty (* failwith "cannot import this kind of type (ptr, fptr)" *) - | ILType.Modified(_, _, ty) -> - // All custom modifiers are ignored + | ILType.Modified(_, _, ty) -> + // All custom modifiers are ignored ImportILType env m tinst ty - | ILType.TypeVar u16 -> - let ty = - try + | ILType.TypeVar u16 -> + let ty = + try List.item (int u16) tinst - with _ -> + with _ -> error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(), m)) let tyWithNullness = addNullnessToTy Nullness.knownAmbivalent ty tyWithNullness /// Import an IL type as an F# type. -let rec ImportILTypeWithNullness (env: ImportMap) m tinst (nf:Nullness.NullableFlags) ty : struct(TType*Nullness.NullableFlags) = +let rec ImportILTypeWithNullness (env: ImportMap) m tinst (nf:Nullness.NullableFlags) ty : struct(TType*Nullness.NullableFlags) = match ty with - | ILType.Void -> + | ILType.Void -> env.g.unit_ty,nf - | ILType.Array(bounds, innerTy) -> + | ILType.Array(bounds, innerTy) -> let n = bounds.Rank let (arrayNullness,nf) = Nullness.evaluateFirstOrderNullnessAndAdvance ty nf let struct(elemTy,nf) = ImportILTypeWithNullness env m tinst nf innerTy mkArrayTy env.g n arrayNullness elemTy m, nf | ILType.Boxed tspec | ILType.Value tspec -> - let tcref = ImportILTypeRef env m tspec.TypeRef + let tcref = ImportILTypeRef env m tspec.TypeRef let (typeRefNullness,nf) = Nullness.evaluateFirstOrderNullnessAndAdvance ty nf let struct(inst,nullableFlagsLeft) = (nf,tspec.GenericArgs) ||> List.vMapFold (fun nf current -> ImportILTypeWithNullness env m tinst nf current ) ImportTyconRefApp env tcref inst typeRefNullness, nullableFlagsLeft - | ILType.Byref ty -> - let struct(ttype,nf) = ImportILTypeWithNullness env m tinst nf ty + | ILType.Byref ty -> + let struct(ttype,nf) = ImportILTypeWithNullness env m tinst nf ty mkByrefTy env.g ttype, nf | ILType.Ptr ILType.Void when env.g.voidptr_tcr.CanDeref -> mkVoidPtrTy env.g, nf - | ILType.Ptr ty -> - let struct(ttype,nf) = ImportILTypeWithNullness env m tinst nf ty + | ILType.Ptr ty -> + let struct(ttype,nf) = ImportILTypeWithNullness env m tinst nf ty mkNativePtrTy env.g ttype, nf | ILType.FunctionPointer _ -> env.g.nativeint_ty, nf (* failwith "cannot import this kind of type (ptr, fptr)" *) - | ILType.Modified(_, _, ty) -> - // All custom modifiers are ignored - ImportILTypeWithNullness env m tinst nf ty + | ILType.Modified(_, _, ty) -> + // All custom modifiers are ignored + ImportILTypeWithNullness env m tinst nf ty - | ILType.TypeVar u16 -> - let ttype = - try + | ILType.TypeVar u16 -> + let ttype = + try List.item (int u16) tinst - with _ -> + with _ -> error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(), m)) let (typeVarNullness,nf) = Nullness.evaluateFirstOrderNullnessAndAdvance ty nf addNullnessToTy typeVarNullness ttype, nf /// Determines if an IL type can be imported as an F# type -let rec CanImportILType (env: ImportMap) m ty = +let rec CanImportILType (env: ImportMap) m ty = match ty with | ILType.Void -> true | ILType.Array(_bounds, ety) -> CanImportILType env m ety | ILType.Boxed tspec | ILType.Value tspec -> - CanImportILTypeRef env m tspec.TypeRef - && tspec.GenericArgs |> List.forall (CanImportILType env m) + CanImportILTypeRef env m tspec.TypeRef + && tspec.GenericArgs |> List.forall (CanImportILType env m) | ILType.Byref ety -> CanImportILType env m ety | ILType.Ptr ety -> CanImportILType env m ety @@ -386,91 +435,91 @@ let rec CanImportILType (env: ImportMap) m ty = #if !NO_TYPEPROVIDERS /// Import a provided type reference as an F# type TyconRef -let ImportProvidedNamedType (env: ImportMap) (m: range) (st: Tainted) = +let ImportProvidedNamedType (env: ImportMap) (m: range) (st: Tainted) = // See if a reverse-mapping exists for a generated/relocated System.Type - match st.PUntaint((fun st -> st.TryGetTyconRef()), m) with + match st.PUntaint((fun st -> st.TryGetTyconRef()), m) with | Some x -> (x :?> TyconRef) - | None -> + | None -> let tref = GetILTypeRefOfProvidedType (st, m) ImportILTypeRef env m tref /// Import a provided type as an AbstractIL type -let rec ImportProvidedTypeAsILType (env: ImportMap) (m: range) (st: Tainted) = +let rec ImportProvidedTypeAsILType (env: ImportMap) (m: range) (st: Tainted) = if st.PUntaint ((fun x -> x.IsVoid), m) then ILType.Void elif st.PUntaint((fun st -> st.IsGenericParameter), m) then mkILTyvarTy (uint16 (st.PUntaint((fun st -> st.GenericParameterPosition), m))) - elif st.PUntaint((fun st -> st.IsArray), m) then + elif st.PUntaint((fun st -> st.IsArray), m) then let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) ILType.Array(ILArrayShape.FromRank (st.PUntaint((fun st -> st.GetArrayRank()), m)), et) - elif st.PUntaint((fun st -> st.IsByRef), m) then + elif st.PUntaint((fun st -> st.IsByRef), m) then let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) ILType.Byref et - elif st.PUntaint((fun st -> st.IsPointer), m) then + elif st.PUntaint((fun st -> st.IsPointer), m) then let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) ILType.Ptr et else - let gst, genericArgs = - if st.PUntaint((fun st -> st.IsGenericType), m) then - let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedTypeAsILType env m) |> List.ofArray + let gst, genericArgs = + if st.PUntaint((fun st -> st.IsGenericType), m) then + let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedTypeAsILType env m) |> List.ofArray let gst = st.PApply((fun st -> st.GetGenericTypeDefinition()), m) gst, args - else + else st, [] let tref = GetILTypeRefOfProvidedType (gst, m) let tcref = ImportProvidedNamedType env m gst let tps = tcref.Typars m - if tps.Length <> genericArgs.Length then + if tps.Length <> genericArgs.Length then error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length), m)) // We're converting to an IL type, where generic arguments are erased let genericArgs = List.zip tps genericArgs |> List.filter (fun (tp, _) -> not tp.IsErased) |> List.map snd let tspec = mkILTySpec(tref, genericArgs) - if st.PUntaint((fun st -> st.IsValueType), m) then - ILType.Value tspec - else + if st.PUntaint((fun st -> st.IsValueType), m) then + ILType.Value tspec + else mkILBoxedType tspec /// Import a provided type as an F# type. -let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) (st: Tainted) = +let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) (st: Tainted) = - // Explanation: The two calls below represent am unchecked invariant of the hosted compiler: - // that type providers are only activated on the CompilationThread. This invariant is not currently checked + // Explanation: The two calls below represent am unchecked invariant of the hosted compiler: + // that type providers are only activated on the CompilationThread. This invariant is not currently checked // via CompilationThreadToken passing. We leave the two calls below as a reminder of this. // - // This function is one major source of type provider activations, but not the only one: almost + // This function is one major source of type provider activations, but not the only one: almost // any call in the 'TypeProviders' module is a potential type provider activation. let ctok = AssumeCompilationThreadWithoutEvidence () RequireCompilationThread ctok let g = env.g - if st.PUntaint((fun st -> st.IsArray), m) then + if st.PUntaint((fun st -> st.IsArray), m) then let elemTy = ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m)) // TODO Nullness - integration into type providers as a separate feature for later. let nullness = Nullness.knownAmbivalent mkArrayTy g (st.PUntaint((fun st -> st.GetArrayRank()), m)) nullness elemTy m - elif st.PUntaint((fun st -> st.IsByRef), m) then + elif st.PUntaint((fun st -> st.IsByRef), m) then let elemTy = ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m)) mkByrefTy g elemTy - elif st.PUntaint((fun st -> st.IsPointer), m) then + elif st.PUntaint((fun st -> st.IsPointer), m) then let elemTy = ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m)) - if isUnitTy g elemTy || isVoidTy g elemTy && g.voidptr_tcr.CanDeref then - mkVoidPtrTy g + if isUnitTy g elemTy || isVoidTy g elemTy && g.voidptr_tcr.CanDeref then + mkVoidPtrTy g else mkNativePtrTy g elemTy else // REVIEW: Extension type could try to be its own generic arg (or there could be a type loop) - let tcref, genericArgs = - if st.PUntaint((fun st -> st.IsGenericType), m) then + let tcref, genericArgs = + if st.PUntaint((fun st -> st.IsGenericType), m) then let tcref = ImportProvidedNamedType env m (st.PApply((fun st -> st.GetGenericTypeDefinition()), m)) - let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedType env m (* tinst *) ) |> List.ofArray + let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedType env m (* tinst *) ) |> List.ofArray tcref, args - else + else let tcref = ImportProvidedNamedType env m st - tcref, [] - + tcref, [] + let genericArgsLength = genericArgs.Length - /// Adjust for the known primitive numeric types that accept units of measure. + /// Adjust for the known primitive numeric types that accept units of measure. let tcref = if genericArgsLength = 1 then // real @@ -496,22 +545,22 @@ let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) ( tcref let tps = tcref.Typars m - if tps.Length <> genericArgsLength then + if tps.Length <> genericArgsLength then error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgsLength), m)) - let genericArgs = - (tps, genericArgs) ||> List.map2 (fun tp genericArg -> - if tp.Kind = TyparKind.Measure then - let rec conv ty = - match ty with + let genericArgs = + (tps, genericArgs) ||> List.map2 (fun tp genericArg -> + if tp.Kind = TyparKind.Measure then + let rec conv ty = + match ty with | TType_app (tcref, [ty1;ty2], _) when tyconRefEq g tcref g.measureproduct_tcr -> Measure.Prod (conv ty1, conv ty2) | TType_app (tcref, [ty1], _) when tyconRefEq g tcref g.measureinverse_tcr -> Measure.Inv (conv ty1) - | TType_app (tcref, [], _) when tyconRefEq g tcref g.measureone_tcr -> Measure.One + | TType_app (tcref, [], _) when tyconRefEq g tcref g.measureone_tcr -> Measure.One | TType_app (tcref, [], _) when tcref.TypeOrMeasureKind = TyparKind.Measure -> Measure.Const tcref - | TType_app (tcref, _, _) -> + | TType_app (tcref, _, _) -> errorR(Error(FSComp.SR.impInvalidMeasureArgument1(tcref.CompiledName, tp.Name), m)) Measure.One - | _ -> + | _ -> errorR(Error(FSComp.SR.impInvalidMeasureArgument2(tp.Name), m)) Measure.One @@ -525,82 +574,82 @@ let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) ( ImportTyconRefApp env tcref genericArgs nullness /// Import a provided method reference as an Abstract IL method reference -let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Tainted) = +let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Tainted) = let tref = GetILTypeRefOfProvidedType (mbase.PApply((fun mbase -> nonNull mbase.DeclaringType), m), m) - let mbase = + let mbase = // Find the formal member corresponding to the called member - match mbase.OfType() with - | Some minfo when - minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| (nonNull minfo.DeclaringType).IsGenericType), m) -> + match mbase.OfType() with + | Some minfo when + minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| (nonNull minfo.DeclaringType).IsGenericType), m) -> let declaringType = minfo.PApply((fun minfo -> nonNull minfo.DeclaringType), m) - let declaringGenericTypeDefn = - if declaringType.PUntaint((fun t -> t.IsGenericType), m) then + let declaringGenericTypeDefn = + if declaringType.PUntaint((fun t -> t.IsGenericType), m) then declaringType.PApply((fun declaringType -> declaringType.GetGenericTypeDefinition()), m) - else + else declaringType - let methods = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetMethods()), "GetMethods", m) + let methods = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetMethods()), "GetMethods", m) let metadataToken = minfo.PUntaint((fun minfo -> minfo.MetadataToken), m) - let found = methods |> Array.tryFind (fun x -> x.PUntaint((fun x -> x.MetadataToken), m) = metadataToken) + let found = methods |> Array.tryFind (fun x -> x.PUntaint((fun x -> x.MetadataToken), m) = metadataToken) match found with | Some found -> found.Coerce(m) - | None -> + | None -> let methodName = minfo.PUntaint((fun minfo -> minfo.Name), m) let typeName = declaringGenericTypeDefn.PUntaint((fun declaringGenericTypeDefn -> declaringGenericTypeDefn.FullName), m) error(Error(FSComp.SR.etIncorrectProvidedMethod(DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m)) - | _ -> - match mbase.OfType() with - | Some cinfo when cinfo.PUntaint((fun x -> (nonNull x.DeclaringType).IsGenericType), m) -> + | _ -> + match mbase.OfType() with + | Some cinfo when cinfo.PUntaint((fun x -> (nonNull x.DeclaringType).IsGenericType), m) -> let declaringType = cinfo.PApply((fun x -> nonNull x.DeclaringType), m) let declaringGenericTypeDefn = declaringType.PApply((fun x -> x.GetGenericTypeDefinition()), m) // We have to find the uninstantiated formal signature corresponding to this instantiated constructor. // Annoyingly System.Reflection doesn't give us a MetadataToken to compare on, so we have to look by doing // the instantiation and comparing.. - let found = - let ctors = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetConstructors()), "GetConstructors", m) + let found = + let ctors = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetConstructors()), "GetConstructors", m) - let actualParamTys = + let actualParamTys = [ for p in cinfo.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do ImportProvidedType env m (p.PApply((fun p -> p.ParameterType), m)) ] let actualGenericArgs = argsOfAppTy env.g (ImportProvidedType env m declaringType) - ctors |> Array.tryFind (fun ctor -> - let formalParamTysAfterInst = + ctors |> Array.tryFind (fun ctor -> + let formalParamTysAfterInst = [ for p in ctor.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do let ilFormalTy = ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType), m)) // TODO Nullness - integration into type providers as a separate feature for later. yield ImportILType env m actualGenericArgs ilFormalTy ] (formalParamTysAfterInst, actualParamTys) ||> List.lengthsEqAndForall2 (typeEquiv env.g)) - + match found with | Some found -> found.Coerce(m) - | None -> + | None -> let typeName = declaringGenericTypeDefn.PUntaint((fun x -> x.FullName), m) error(Error(FSComp.SR.etIncorrectProvidedConstructor(DisplayNameOfTypeProvider(cinfo.TypeProvider, m), typeName), m)) | _ -> mbase - let retTy = - match mbase.OfType() with + let retTy = + match mbase.OfType() with | Some minfo -> minfo.PApply((fun minfo -> minfo.ReturnType), m) | None -> match mbase.OfType() with | Some _ -> mbase.PApply((fun _ -> ProvidedType.Void), m) | _ -> failwith "ImportProvidedMethodBaseAsILMethodRef - unexpected" - let genericArity = - if mbase.PUntaint((fun x -> x.IsGenericMethod), m) then + let genericArity = + if mbase.PUntaint((fun x -> x.IsGenericMethod), m) then mbase.PUntaint((fun x -> x.GetGenericArguments().Length), m) else 0 let callingConv = (if mbase.PUntaint((fun x -> x.IsStatic), m) then ILCallingConv.Static else ILCallingConv.Instance) - let ilParamTys = + let ilParamTys = [ for p in mbase.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do yield ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType), m)) ] @@ -613,38 +662,38 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta // Load an IL assembly into the compiler's internal data structures // Careful use is made of laziness here to ensure we don't read the entire IL // assembly on startup. -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- /// Import a set of Abstract IL generic parameter specifications as a list of new -/// F# generic parameters. -/// +/// F# generic parameters. +/// /// Fixup the constraints so that any references to the generic parameters /// in the constraints now refer to the new generic parameters. -let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.NullableContextSource) (gps: ILGenericParameterDefs) = - match gps with +let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.NullableContextSource) (gps: ILGenericParameterDefs) = + match gps with | [] -> [] - | _ -> + | _ -> let amap : ImportMap = amap() - let tps = gps |> List.map (fun gp -> Construct.NewRigidTypar gp.Name m) + let tps = gps |> List.map (fun gp -> Construct.NewRigidTypar gp.Name m) let tptys = tps |> List.map mkTyparTy let importInst = tinst@tptys - (tps, gps) ||> List.iter2 (fun tp gp -> + (tps, gps) ||> List.iter2 (fun tp gp -> if gp.Variance = ILGenericVariance.ContraVariant then tp.MarkAsContravariant() - let constraints = - [ + let constraints = + [ if amap.g.langFeatureNullness && amap.g.checkNullness then - let nullness = + let nullness = { Nullness.DirectAttributes = Nullness.AttributesFromIL(gp.MetadataIndex,gp.CustomAttrsStored) Nullness.Fallback = nullableFallback } - + match nullness.GetFlags(amap.g) with | [|1uy|] -> TyparConstraint.NotSupportsNull(m) // In F#, 'SupportsNull' has the meaning of "must support null as a value". In C#, Nullable(2) is an allowance, not a requirement. //| [|2uy|] -> TyparConstraint.SupportsNull(m) - | _ -> () - + | _ -> () + if gp.CustomAttrs |> TryFindILAttribute amap.g.attrib_IsUnmanagedAttribute then TyparConstraint.IsUnmanaged(m) if gp.HasDefaultConstructorConstraint then @@ -656,29 +705,29 @@ let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.Nul if gp.HasAllowsRefStruct then TyparConstraint.AllowsRefStruct(m) for ilTy in gp.Constraints do - TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilTy), m) ] + TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilTy), m) ] tp.SetConstraints constraints) tps /// Given a list of items each keyed by an ordered list of keys, apply 'nodef' to the each group -/// with the same leading key. Apply 'tipf' to the elements where the keylist is empty, and return -/// the overall results. Used to bucket types, so System.Char and System.Collections.Generic.List +/// with the same leading key. Apply 'tipf' to the elements where the keylist is empty, and return +/// the overall results. Used to bucket types, so System.Char and System.Collections.Generic.List /// both get initially bucketed under 'System'. -let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = - // Find all the items with an empty key list and call 'tipf' - let tips = - [ for keylist, v in items do - match keylist with +let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = + // Find all the items with an empty key list and call 'tipf' + let tips = + [ for keylist, v in items do + match keylist with | [] -> yield tipf v | _ -> () ] // Find all the items with a non-empty key list. Bucket them together by // the first key. For each bucket, call 'nodef' on that head key and the bucket. - let nodes = + let nodes = let buckets = Dictionary<_, _>(10) for keylist, v in items do - match keylist with + match keylist with | [] -> () | key :: rest -> buckets[key] <- @@ -692,7 +741,7 @@ let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = /// Import an IL type definition as a new F# TAST Entity node. let rec ImportILTypeDef amap m scoref (cpath: CompilationPath) enc nm (tdef: ILTypeDef) = - let lazyModuleOrNamespaceTypeForNestedTypes = + let lazyModuleOrNamespaceTypeForNestedTypes = InterruptibleLazy(fun _ -> let cpath = cpath.NestedCompPath nm ModuleOrType ImportILTypeDefs amap m scoref cpath (enc@[tdef]) tdef.NestedTypes @@ -700,41 +749,41 @@ let rec ImportILTypeDef amap m scoref (cpath: CompilationPath) enc nm (tdef: ILT let nullableFallback = Nullness.FromClass(Nullness.AttributesFromIL(tdef.MetadataIndex,tdef.CustomAttrsStored)) - // Add the type itself. - Construct.NewILTycon - (Some cpath) - (nm, m) + // Add the type itself. + Construct.NewILTycon + (Some cpath) + (nm, m) // The read of the type parameters may fail to resolve types. We pick up a new range from the point where that read is forced // Make sure we reraise the original exception one occurs - see findOriginalException. (LazyWithContext.Create((fun m -> ImportILGenericParameters amap m scoref [] nullableFallback tdef.GenericParams), findOriginalException)) - (scoref, enc, tdef) + (scoref, enc, tdef) (MaybeLazy.Lazy lazyModuleOrNamespaceTypeForNestedTypes) - + /// Import a list of (possibly nested) IL types as a new ModuleOrNamespaceType node /// containing new entities, bucketing by namespace along the way. and ImportILTypeDefList amap m (cpath: CompilationPath) enc items = // Split into the ones with namespaces and without. Add the ones with namespaces in buckets. - // That is, discriminate based in the first element of the namespace list (e.g. "System") + // That is, discriminate based in the first element of the namespace list (e.g. "System") // and, for each bag, fold-in a lazy computation to add the types under that bag . // // nodef - called for each bucket, where 'n' is the head element of the namespace used // as a key in the discrimination, tgs is the remaining descriptors. We create an entity for 'n'. // - // tipf - called if there are no namespace items left to discriminate on. - let entities = - items - |> multisetDiscriminateAndMap + // tipf - called if there are no namespace items left to discriminate on. + let entities = + items + |> multisetDiscriminateAndMap (fun n tgs -> let modty = InterruptibleLazy(fun _ -> ImportILTypeDefList amap m (cpath.NestedCompPath n (Namespace true)) enc tgs) Construct.NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) - (fun (n, info: InterruptibleLazy<_>) -> + (fun (n, info: InterruptibleLazy<_>) -> let (scoref2, lazyTypeDef: ILPreTypeDef) = info.Force() ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.GetTypeDef())) let kind = match enc with [] -> Namespace true | _ -> ModuleOrType Construct.NewModuleOrNamespaceType kind entities [] - + /// Import a table of IL types as a ModuleOrNamespaceType. /// and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = @@ -748,49 +797,49 @@ and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = /// /// Example: for a collection of types "System.Char", "System.Int32" and "Library.C" /// the return ModuleOrNamespaceType will contain namespace entities for "System" and "Library", which in turn contain -/// type definition entities for ["Char"; "Int32"] and ["C"] respectively. -let ImportILAssemblyMainTypeDefs amap m scoref modul = - modul.TypeDefs |> ImportILTypeDefs amap m scoref (CompPath(scoref, SyntaxAccess.Unknown, [])) [] +/// type definition entities for ["Char"; "Int32"] and ["C"] respectively. +let ImportILAssemblyMainTypeDefs amap m scoref modul = + modul.TypeDefs |> ImportILTypeDefs amap m scoref (CompPath(scoref, SyntaxAccess.Unknown, [])) [] -/// Import the "exported types" table for multi-module assemblies. -let ImportILAssemblyExportedType amap m auxModLoader (scoref: ILScopeRef) (exportedType: ILExportedTypeOrForwarder) = +/// Import the "exported types" table for multi-module assemblies. +let ImportILAssemblyExportedType amap m auxModLoader (scoref: ILScopeRef) (exportedType: ILExportedTypeOrForwarder) = // Forwarders are dealt with separately in the ref->def dereferencing logic in tast.fs as they effectively give rise to type equivalences - if exportedType.IsForwarder then + if exportedType.IsForwarder then [] else let ns, n = splitILTypeName exportedType.Name let info = InterruptibleLazy (fun _ -> - match - (try + match + (try let modul = auxModLoader exportedType.ScopeRef let ptd = mkILPreTypeDefComputed (ns, n, (fun () -> modul.TypeDefs.FindByName exportedType.Name)) Some ptd with :? KeyNotFoundException -> None) - with - | None -> + with + | None -> error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m)) - | Some preTypeDef -> + | Some preTypeDef -> scoref, preTypeDef ) [ ImportILTypeDefList amap m (CompPath(scoref, SyntaxAccess.Unknown, [])) [] [(ns, (n, info))] ] -/// Import the "exported types" table for multi-module assemblies. -let ImportILAssemblyExportedTypes amap m auxModLoader scoref (exportedTypes: ILExportedTypesAndForwarders) = - [ for exportedType in exportedTypes.AsList() do +/// Import the "exported types" table for multi-module assemblies. +let ImportILAssemblyExportedTypes amap m auxModLoader scoref (exportedTypes: ILExportedTypesAndForwarders) = + [ for exportedType in exportedTypes.AsList() do yield! ImportILAssemblyExportedType amap m auxModLoader scoref exportedType ] -/// Import both the main type definitions and the "exported types" table, i.e. all the +/// Import both the main type definitions and the "exported types" table, i.e. all the /// types defined in an IL assembly. -let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod: ILModuleDef) = +let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod: ILModuleDef) = let scoref = ILScopeRef.Assembly aref let mtypsForExportedTypes = ImportILAssemblyExportedTypes amap m auxModLoader scoref mainmod.ManifestOfAssembly.ExportedTypes let mainmod = ImportILAssemblyMainTypeDefs amap m scoref mainmod CombineCcuContentFragments (mainmod :: mtypsForExportedTypes) /// Import the type forwarder table for an IL assembly -let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders): CcuTypeForwarderTable = +let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndForwarders): CcuTypeForwarderTable = let rec addToTree tree path item value = match path with | [] -> @@ -843,22 +892,22 @@ let ImportILAssemblyTypeForwarders (amap, m, exportedTypes: ILExportedTypesAndFo |> addNested exportedType exportedType.Nested [yield! ns; yield n] ) |> fun root -> { Root = root } - + /// Import an IL assembly as a new TAST CCU -let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoader: IXmlDocumentationInfoLoader option, ilScopeRef, sourceDir, fileName, ilModule: ILModuleDef, invalidateCcu: IEvent) = +let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoader: IXmlDocumentationInfoLoader option, ilScopeRef, sourceDir, fileName, ilModule: ILModuleDef, invalidateCcu: IEvent) = invalidateCcu |> ignore - let aref = - match ilScopeRef with - | ILScopeRef.Assembly aref -> aref + let aref = + match ilScopeRef with + | ILScopeRef.Assembly aref -> aref | _ -> error(InternalError("ImportILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead", m)) let nm = aref.Name let mty = ImportILAssemblyTypeDefs(amap, m, auxModuleLoader, aref, ilModule) - let forwarders = - match ilModule.Manifest with + let forwarders = + match ilModule.Manifest with | None -> CcuTypeForwarderTable.Empty | Some manifest -> ImportILAssemblyTypeForwarders(amap, m, manifest.ExportedTypes) - let ccuData: CcuData = + let ccuData: CcuData = { IsFSharp=false UsesFSharp20PlusQuotations=false #if !NO_TYPEPROVIDERS @@ -867,20 +916,20 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad ImportProvidedType = (fun ty -> ImportProvidedType (amap()) m ty) #endif QualifiedName= Some ilScopeRef.QualifiedName - Contents = Construct.NewCcuContents ilScopeRef m nm mty + Contents = Construct.NewCcuContents ilScopeRef m nm mty ILScopeRef = ilScopeRef Stamp = newStamp() - SourceCodeDirectory = sourceDir // note: not an accurate value, but IL assemblies don't give us this information in any attributes. + SourceCodeDirectory = sourceDir // note: not an accurate value, but IL assemblies don't give us this information in any attributes. FileName = fileName MemberSignatureEquality= (fun ty1 ty2 -> typeEquivAux EraseAll (amap()).g ty1 ty2) TryGetILModuleDef = (fun () -> Some ilModule) TypeForwarders = forwarders - XmlDocumentationInfo = + XmlDocumentationInfo = match xmlDocInfoLoader, fileName with | Some xmlDocInfoLoader, Some fileName -> xmlDocInfoLoader.TryLoad(fileName) | _ -> None } - + CcuThunk.Create(nm, ccuData) //------------------------------------------------------------------------- @@ -889,7 +938,7 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad /// Import an IL type as an F# type. importInst gives the context for interpreting type variables. let RescopeAndImportILTypeSkipNullness scoref amap m importInst ilTy = - ilTy |> rescopeILType scoref |> ImportILType amap m importInst + ilTy |> rescopeILType scoref |> ImportILType amap m importInst let RescopeAndImportILType scoref (amap:ImportMap) m importInst (nullnessSource:Nullness.NullableAttributesSource) ilTy = let g = amap.g @@ -905,4 +954,3 @@ let RescopeAndImportILType scoref (amap:ImportMap) m importInst (nullnessSource: let CanRescopeAndImportILType scoref amap m ilTy = ilTy |> rescopeILType scoref |> CanImportILType amap m - diff --git a/src/Compiler/Checking/import.fsi b/src/Compiler/Checking/import.fsi index fb1f191effc..001f9367989 100644 --- a/src/Compiler/Checking/import.fsi +++ b/src/Compiler/Checking/import.fsi @@ -10,6 +10,8 @@ open FSharp.Compiler.Text open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree +open System.Collections.Concurrent + #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders #endif @@ -35,6 +37,26 @@ type AssemblyLoader = abstract RecordGeneratedTypeRoot: ProviderGeneratedType -> unit #endif +[] +type CanCoerce = + | CanCoerce + | NoCoerce + +[] +type TTypeCacheKey = + interface System.IEquatable + private new: ty1: TType * ty2: TType * canCoerce: CanCoerce * tcGlobals: TcGlobals -> TTypeCacheKey + + static member FromStrippedTypes: + ty1: TType * ty2: TType * canCoerce: CanCoerce * tcGlobals: TcGlobals -> TTypeCacheKey + + val ty1: TType + val ty2: TType + val canCoerce: CanCoerce + val tcGlobals: TcGlobals + override Equals: other: obj -> bool + override GetHashCode: unit -> int + /// Represents a context used for converting AbstractIL .NET and provided types to F# internal compiler data structures. /// Also cache the conversion of AbstractIL ILTypeRef nodes, based on hashes of these. /// @@ -51,6 +73,9 @@ type ImportMap = /// The TcGlobals for the import context member g: TcGlobals + /// Type subsumption cache + member TypeSubsumptionCache: ConcurrentDictionary + module Nullness = [] diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index cd883c6f7c7..bbdc6ad5933 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -620,6 +620,8 @@ type TcConfigBuilder = mutable dumpSignatureData: bool mutable realsig: bool + + mutable compilationMode: TcGlobals.CompilationMode } // Directories to start probing in @@ -834,6 +836,7 @@ type TcConfigBuilder = dumpSignatureData = false realsig = false strictIndentation = None + compilationMode = TcGlobals.CompilationMode.Unset } member tcConfigB.FxResolver = @@ -1378,6 +1381,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.typeCheckingConfig = data.typeCheckingConfig member _.dumpSignatureData = data.dumpSignatureData member _.realsig = data.realsig + member _.compilationMode = data.compilationMode static member Create(builder, validate) = use _ = UseBuildPhase BuildPhase.Parameter diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 98c52f900e0..24bcbf82817 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -525,6 +525,8 @@ type TcConfigBuilder = mutable dumpSignatureData: bool mutable realsig: bool + + mutable compilationMode: TcGlobals.CompilationMode } static member CreateNew: @@ -904,6 +906,8 @@ type TcConfig = member realsig: bool + member compilationMode: TcGlobals.CompilationMode + /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. [] diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index fb6a6526eab..c54ccc41c58 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2614,7 +2614,8 @@ and [] TcImports tcConfig.noDebugAttributes, tcConfig.pathMap, tcConfig.langVersion, - tcConfig.realsig + tcConfig.realsig, + tcConfig.compilationMode ) #if DEBUG diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index b986d78663a..1d17950a9ac 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -21,6 +21,7 @@ open System.Text open System.Threading open Internal.Utilities +open Internal.Utilities.TypeHashing open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -505,7 +506,8 @@ let main1 defaultCopyFSharpCore = defaultCopyFSharpCore, tryGetMetadataSnapshot = tryGetMetadataSnapshot, sdkDirOverride = None, - rangeForErrors = range0 + rangeForErrors = range0, + compilationMode = CompilationMode.OneOff ) tcConfigB.exiter <- exiter @@ -901,11 +903,7 @@ let main3 TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute topAttrs.assemblyAttrs |> Option.isSome - let observer = - if hasIvt then - Fsharp.Compiler.SignatureHash.PublicAndInternal - else - Fsharp.Compiler.SignatureHash.PublicOnly + let observer = if hasIvt then PublicAndInternal else PublicOnly let optDataHash = optDataResources diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 9a6b69fa2ff..6a65a1d71d9 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1783,6 +1783,7 @@ featureEmptyBodiedComputationExpressions,"Support for computation expressions wi featureAllowAccessModifiersToAutoPropertiesGettersAndSetters,"Allow access modifiers to auto properties getters and setters" 3871,tcAccessModifiersNotAllowedInSRTPConstraint,"Access modifiers cannot be applied to an SRTP constraint." featureAllowObjectExpressionWithoutOverrides,"Allow object expressions without overrides" +featureUseTypeSubsumptionCache,"Use type conversion cache during compilation" 3872,tcPartialActivePattern,"Multi-case partial active patterns are not supported. Consider using a single-case partial active pattern or a full active pattern." 3873,chkDeprecatePlacesWhereSeqCanBeOmitted,"This construct is deprecated. Sequence expressions should be of the form 'seq {{ ... }}'" -featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" \ No newline at end of file +featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index cf3e820b879..659eb21edb9 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -334,6 +334,7 @@ + diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 3488a3399e1..ac66fa03e72 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -94,6 +94,7 @@ type LanguageFeature = | ParsedHashDirectiveArgumentNonQuotes | EmptyBodiedComputationExpressions | AllowObjectExpressionWithoutOverrides + | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted /// LanguageVersion management @@ -216,6 +217,7 @@ type LanguageVersion(versionText) = LanguageFeature.EnforceAttributeTargets, languageVersion90 // F# preview + LanguageFeature.UseTypeSubsumptionCache, previewVersion LanguageFeature.UnmanagedConstraintCsharpInterop, previewVersion // not enabled because: https://github.com/dotnet/fsharp/issues/17509 LanguageFeature.FromEndSlicing, previewVersion // Unfinished features --- needs work LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters, previewVersion @@ -377,6 +379,7 @@ type LanguageVersion(versionText) = | LanguageFeature.ParsedHashDirectiveArgumentNonQuotes -> FSComp.SR.featureParsedHashDirectiveArgumentNonString () | LanguageFeature.EmptyBodiedComputationExpressions -> FSComp.SR.featureEmptyBodiedComputationExpressions () | LanguageFeature.AllowObjectExpressionWithoutOverrides -> FSComp.SR.featureAllowObjectExpressionWithoutOverrides () + | LanguageFeature.UseTypeSubsumptionCache -> FSComp.SR.featureUseTypeSubsumptionCache () | LanguageFeature.DeprecatePlacesWhereSeqCanBeOmitted -> FSComp.SR.featureDeprecatePlacesWhereSeqCanBeOmitted () /// Get a version string associated with the given feature. diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index 6396f7b72c0..98149799302 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -85,6 +85,7 @@ type LanguageFeature = | ParsedHashDirectiveArgumentNonQuotes | EmptyBodiedComputationExpressions | AllowObjectExpressionWithoutOverrides + | UseTypeSubsumptionCache | DeprecatePlacesWhereSeqCanBeOmitted /// LanguageVersion management diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index 98101af36fe..1f224ea499c 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -17,6 +17,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy +open Import /// Build the 'test and dispose' part of a 'use' statement let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 6af2b440cc0..1c7878c6df8 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -15,6 +15,7 @@ open FSharp.Compiler.IO open FSharp.Compiler.NicePrint open Internal.Utilities.Library open Internal.Utilities.Library.Extras +open Internal.Utilities.TypeHashing open FSharp.Core.Printf open FSharp.Compiler open FSharp.Compiler.Syntax @@ -537,7 +538,7 @@ type internal TypeCheckInfo // check that type of value is the same or subtype of tcref // yes - allow access to protected members // no - strip ability to access protected members - if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy TypeRelations.CanCoerce ty then + if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy Import.CanCoerce ty then ad else AccessibleFrom(paths, None) @@ -3536,7 +3537,7 @@ type FSharpCheckFileResults |> SourceText.ofString) member internal _.CalculateSignatureHash() = - let visibility = Fsharp.Compiler.SignatureHash.PublicAndInternal + let visibility = PublicAndInternal match details with | None -> failwith "Typechecked details not available for CalculateSignatureHash() operation." diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 29059b4873b..872b27fdcd9 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -547,7 +547,7 @@ type FrameworkImportsCache(size) = lazyWork ) node - + /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them. member this.Get(tcConfig: TcConfig) = @@ -577,7 +577,8 @@ type FrameworkImportsCache(size) = tcGlobals.noDebugAttributes, tcGlobals.pathMap, tcConfig.langVersion, - tcConfig.realsig + tcConfig.realsig, + tcConfig.compilationMode ) else diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 531ef79d264..0bf99b86572 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -175,6 +175,13 @@ let tname_IsByRefLikeAttribute = "System.Runtime.CompilerServices.IsByRefLikeAtt // Table of all these "globals" //------------------------------------------------------------------------- +[] +type CompilationMode = + | Unset + | OneOff + | Service + | Interactive + type TcGlobals( compilingFSharpCore: bool, ilg: ILGlobals, @@ -190,10 +197,11 @@ type TcGlobals( noDebugAttributes: bool, pathMap: PathMap, langVersion: LanguageVersion, - realsig: bool) = + realsig: bool, + compilationMode: CompilationMode) = let v_langFeatureNullness = langVersion.SupportsFeature LanguageFeature.NullnessChecking - + let v_knownWithNull = if v_langFeatureNullness then KnownWithNull else KnownAmbivalentToNull @@ -1825,6 +1833,8 @@ type TcGlobals( /// Are we assuming all code gen is for F# interactive, with no static linking member _.isInteractive=isInteractive + member val compilationMode = compilationMode + /// Indicates if we are generating witness arguments for SRTP constraints. Only done if the FSharp.Core /// supports witness arguments. member g.generateWitnesses = diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index b7d5a892d06..73d26a64b62 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -2,6 +2,15 @@ module internal FSharp.Compiler.TcGlobals +/// Signals how checker/compiler was invoked - from FSC task/process (a one-off compilation), from tooling or from interactive session. +/// This is used to determine if we want to use certain features in the pipeline, for example, type subsumption cache is only used in one-off compilation now. +[] +type CompilationMode = + | Unset // Default: not set + | OneOff // Running the FSC task/process + | Service // Running from service + | Interactive // Running from interactive session + val internal DummyFileNameForRangesWithoutASpecificLocation: string /// Represents an intrinsic value from FSharp.Core known to the compiler @@ -147,7 +156,8 @@ type internal TcGlobals = noDebugAttributes: bool * pathMap: Internal.Utilities.PathMap * langVersion: FSharp.Compiler.Features.LanguageVersion * - realsig: bool -> + realsig: bool * + compilationMode: CompilationMode -> TcGlobals static member IsInEmbeddableKnownSet: name: string -> bool @@ -810,6 +820,8 @@ type internal TcGlobals = /// Are we assuming all code gen is for F# interactive, with no static linking member isInteractive: bool + member compilationMode: CompilationMode + member isnull_info: IntrinsicValRef member istype_fast_vref: FSharp.Compiler.TypedTree.ValRef diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs new file mode 100644 index 00000000000..bcdface38be --- /dev/null +++ b/src/Compiler/Utilities/TypeHashing.fs @@ -0,0 +1,346 @@ +module internal Internal.Utilities.TypeHashing + +open Internal.Utilities.Rational +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps + +type ObserverVisibility = + | PublicOnly + | PublicAndInternal + +[] +module internal HashingPrimitives = + + type Hash = int + + let inline hashText (s: string) : Hash = hash s + let inline combineHash acc y : Hash = (acc <<< 1) + y + 631 + let inline pipeToHash (value: Hash) (acc: Hash) = combineHash acc value + let inline addFullStructuralHash (value) (acc: Hash) = combineHash (acc) (hash value) + + let inline hashListOrderMatters ([] func) (items: #seq<'T>) : Hash = + let mutable acc = 0 + + for i in items do + let valHash = func i + // We are calling hashListOrderMatters for things like list of types, list of properties, list of fields etc. The ones which are visibility-hidden will return 0, and are omitted. + if valHash <> 0 then + acc <- combineHash acc valHash + + acc + + let inline hashListOrderIndependent ([] func) (items: #seq<'T>) : Hash = + let mutable acc = 0 + + for i in items do + let valHash = func i + acc <- acc ^^^ valHash + + acc + + let (@@) (h1: Hash) (h2: Hash) = combineHash h1 h2 + +[] +module internal HashUtilities = + + let private hashEntityRefName (xref: EntityRef) name = + let tag = + if xref.IsNamespace then + TextTag.Namespace + elif xref.IsModule then + TextTag.Module + elif xref.IsTypeAbbrev then + TextTag.Alias + elif xref.IsFSharpDelegateTycon then + TextTag.Delegate + elif xref.IsILEnumTycon || xref.IsFSharpEnumTycon then + TextTag.Enum + elif xref.IsStructOrEnumTycon then + TextTag.Struct + elif isInterfaceTyconRef xref then + TextTag.Interface + elif xref.IsUnionTycon then + TextTag.Union + elif xref.IsRecordTycon then + TextTag.Record + else + TextTag.Class + + (hash tag) @@ (hashText name) + + let hashTyconRefImpl (tcref: TyconRef) = + let demangled = tcref.DisplayNameWithStaticParameters + let tyconHash = hashEntityRefName tcref demangled + + tcref.CompilationPath.AccessPath + |> hashListOrderMatters (fst >> hashText) + |> pipeToHash tyconHash + +module HashIL = + + let hashILTypeRef (tref: ILTypeRef) = + tref.Enclosing + |> hashListOrderMatters hashText + |> addFullStructuralHash tref.Name + + let private hashILArrayShape (sh: ILArrayShape) = sh.Rank + + let rec hashILType (ty: ILType) : Hash = + match ty with + | ILType.Void -> hash ILType.Void + | ILType.Array(sh, t) -> hashILType t @@ hashILArrayShape sh + | ILType.Value t + | ILType.Boxed t -> hashILTypeRef t.TypeRef @@ (t.GenericArgs |> hashListOrderMatters (hashILType)) + | ILType.Ptr t + | ILType.Byref t -> hashILType t + | ILType.FunctionPointer t -> hashILCallingSignature t + | ILType.TypeVar n -> hash n + | ILType.Modified(_, _, t) -> hashILType t + + and hashILCallingSignature (signature: ILCallingSignature) = + let res = signature.ReturnType |> hashILType + signature.ArgTypes |> hashListOrderMatters (hashILType) |> pipeToHash res + +module HashAccessibility = + + let isHiddenToObserver (TAccess access) (observer: ObserverVisibility) = + let isInternalCompPath x = + match x with + | CompPath(ILScopeRef.Local, _, []) -> true + | _ -> false + + match access with + | [] -> false + | _ when List.forall isInternalCompPath access -> + match observer with + // The 'access' means internal, but our observer can see it (e.g. because of IVT attribute) + | PublicAndInternal -> false + | PublicOnly -> true + | _ -> true + +module rec HashTypes = + open Microsoft.FSharp.Core.LanguagePrimitives + + let stampEquals g ty1 ty2 = + match (stripTyEqns g ty1), (stripTyEqns g ty2) with + | TType_app(tcref1, _, _), TType_app(tcref2, _, _) -> tcref1.Stamp.Equals(tcref2.Stamp) + | TType_var(r1, _), TType_var(r2, _) -> r1.Stamp.Equals(r2.Stamp) + | _ -> false + + /// Get has for Stamp for TType_app tyconref and TType_var typar + let hashStamp g ty = + let v: Stamp = + match (stripTyEqns g ty) with + | TType_app(tcref, _, _) -> tcref.Stamp + | TType_var(r, _) -> r.Stamp + | _ -> GenericZero + + hash v + + /// Hash a reference to a type + let hashTyconRef tcref = hashTyconRefImpl tcref + + /// Hash the flags of a member + let hashMemberFlags (memFlags: SynMemberFlags) = hash memFlags + + /// Hash an attribute 'Type(arg1, ..., argN)' + let private hashAttrib (Attrib(tyconRef = tcref)) = hashTyconRefImpl tcref + + let hashAttributeList attrs = + attrs |> hashListOrderIndependent hashAttrib + + let private hashTyparRef (typar: Typar) = + hashText typar.DisplayName + |> addFullStructuralHash (typar.Rigidity) + |> addFullStructuralHash (typar.StaticReq) + + let private hashTyparRefWithInfo (typar: Typar) = + hashTyparRef typar @@ hashAttributeList typar.Attribs + + let private hashConstraint (g: TcGlobals) struct (tp, tpc) = + let tpHash = hashTyparRefWithInfo tp + + match tpc with + | TyparConstraint.CoercesTo(tgtTy, _) -> tpHash @@ 1 @@ hashTType g tgtTy + | TyparConstraint.MayResolveMember(traitInfo, _) -> tpHash @@ 2 @@ hashTraitWithInfo (* denv *) g traitInfo + | TyparConstraint.DefaultsTo(_, ty, _) -> tpHash @@ 3 @@ hashTType g ty + | TyparConstraint.IsEnum(ty, _) -> tpHash @@ 4 @@ hashTType g ty + | TyparConstraint.SupportsComparison _ -> tpHash @@ 5 + | TyparConstraint.SupportsEquality _ -> tpHash @@ 6 + | TyparConstraint.IsDelegate(aty, bty, _) -> tpHash @@ 7 @@ hashTType g aty @@ hashTType g bty + | TyparConstraint.SupportsNull _ -> tpHash @@ 8 + | TyparConstraint.IsNonNullableStruct _ -> tpHash @@ 9 + | TyparConstraint.IsUnmanaged _ -> tpHash @@ 10 + | TyparConstraint.IsReferenceType _ -> tpHash @@ 11 + | TyparConstraint.SimpleChoice(tys, _) -> tpHash @@ 12 @@ (tys |> hashListOrderIndependent (hashTType g)) + | TyparConstraint.RequiresDefaultConstructor _ -> tpHash @@ 13 + | TyparConstraint.NotSupportsNull(_) -> tpHash @@ 14 + | TyparConstraint.AllowsRefStruct _ -> tpHash @@ 15 + + /// Hash type parameter constraints + let private hashConstraints (g: TcGlobals) cxs = + cxs |> hashListOrderIndependent (hashConstraint g) + + let private hashTraitWithInfo (g: TcGlobals) traitInfo = + let nameHash = hashText traitInfo.MemberLogicalName + let memberHash = hashMemberFlags traitInfo.MemberFlags + + let returnTypeHash = + match traitInfo.CompiledReturnType with + | Some t -> hashTType g t + | _ -> -1 + + traitInfo.CompiledObjectAndArgumentTypes + |> hashListOrderIndependent (hashTType g) + |> pipeToHash (nameHash) + |> pipeToHash (returnTypeHash) + |> pipeToHash memberHash + + /// Hash a unit of measure expression + let private hashMeasure unt = + let measuresWithExponents = + ListMeasureVarOccsWithNonZeroExponents unt + |> List.sortBy (fun (tp: Typar, _) -> tp.DisplayName) + + measuresWithExponents + |> hashListOrderIndependent (fun (typar, exp: Rational) -> hashTyparRef typar @@ hash exp) + + /// Hash a type, taking precedence into account to insert brackets where needed + let hashTType (g: TcGlobals) ty = + + match stripTyparEqns ty |> (stripTyEqns g) with + | TType_ucase(UnionCaseRef(tc, _), args) + | TType_app(tc, args, _) -> args |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTyconRef tc) + | TType_anon(anonInfo, tys) -> + tys + |> hashListOrderMatters (hashTType g) + |> pipeToHash (anonInfo.SortedNames |> hashListOrderMatters hashText) + |> addFullStructuralHash (evalAnonInfoIsStruct anonInfo) + | TType_tuple(tupInfo, t) -> + t + |> hashListOrderMatters (hashTType g) + |> addFullStructuralHash (evalTupInfoIsStruct tupInfo) + // Hash a first-class generic type. + | TType_forall(tps, tau) -> tps |> hashListOrderMatters (hashTyparRef) |> pipeToHash (hashTType g tau) + | TType_fun _ -> + let argTys, retTy = stripFunTy g ty + argTys |> hashListOrderMatters (hashTType g) |> pipeToHash (hashTType g retTy) + | TType_var(r, _) -> hashTyparRefWithInfo r + | TType_measure unt -> hashMeasure unt + + // Hash a single argument, including its name and type + let private hashArgInfo (g: TcGlobals) (ty, argInfo: ArgReprInfo) = + + let attributesHash = hashAttributeList argInfo.Attribs + + let nameHash = + match argInfo.Name with + | Some i -> hashText i.idText + | _ -> -1 + + let typeHash = hashTType g ty + + typeHash @@ nameHash @@ attributesHash + + let private hashCurriedArgInfos (g: TcGlobals) argInfos = + argInfos + |> hashListOrderMatters (fun l -> l |> hashListOrderMatters (hashArgInfo g)) + + /// Hash a single type used as the type of a member or value + let hashTopType (g: TcGlobals) argInfos retTy cxs = + let retTypeHash = hashTType g retTy + let cxsHash = hashConstraints g cxs + let argHash = hashCurriedArgInfos g argInfos + + retTypeHash @@ cxsHash @@ argHash + + let private hashTyparInclConstraints (g: TcGlobals) (typar: Typar) = + typar.Constraints + |> hashListOrderIndependent (fun tpc -> hashConstraint g (typar, tpc)) + |> pipeToHash (hashTyparRef typar) + + /// Hash type parameters + let hashTyparDecls (g: TcGlobals) (typars: Typars) = + typars |> hashListOrderMatters (hashTyparInclConstraints g) + + let private hashUncurriedSig (g: TcGlobals) typarInst argInfos retTy = + typarInst + |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) + |> pipeToHash (hashTopType g argInfos retTy []) + + let private hashMemberSigCore (g: TcGlobals) memberToParentInst (typarInst, methTypars: Typars, argInfos, retTy) = + typarInst + |> hashListOrderMatters (fun (typar, ttype) -> hashTyparInclConstraints g typar @@ hashTType g ttype) + |> pipeToHash (hashTopType g argInfos retTy []) + |> pipeToHash ( + memberToParentInst + |> hashListOrderMatters (fun (typar, ty) -> hashTyparRef typar @@ hashTType g ty) + ) + |> pipeToHash (hashTyparDecls g methTypars) + + let hashMemberType (g: TcGlobals) vref typarInst argInfos retTy = + match PartitionValRefTypars g vref with + | Some(_, _, memberMethodTypars, memberToParentInst, _) -> + hashMemberSigCore g memberToParentInst (typarInst, memberMethodTypars, argInfos, retTy) + | None -> hashUncurriedSig g typarInst argInfos retTy + +module HashTastMemberOrVals = + open HashTypes + + let private hashMember (g: TcGlobals, observer) typarInst (v: Val) = + let vref = mkLocalValRef v + + if HashAccessibility.isHiddenToObserver vref.Accessibility observer then + 0 + else + let membInfo = Option.get vref.MemberInfo + let _tps, argInfos, retTy, _ = GetTypeOfMemberInFSharpForm g vref + + let memberFlagsHash = hashMemberFlags membInfo.MemberFlags + let parentTypeHash = hashTyconRef membInfo.ApparentEnclosingEntity + let memberTypeHash = hashMemberType g vref typarInst argInfos retTy + let flagsHash = hash v.val_flags.PickledBits + let nameHash = hashText v.DisplayNameCoreMangled + let attribsHash = hashAttributeList v.Attribs + + let combinedHash = + memberFlagsHash + @@ parentTypeHash + @@ memberTypeHash + @@ flagsHash + @@ nameHash + @@ attribsHash + + combinedHash + + let private hashNonMemberVal (g: TcGlobals, observer) (tps, v: Val, tau, cxs) = + if HashAccessibility.isHiddenToObserver v.Accessibility observer then + 0 + else + let valReprInfo = arityOfValForDisplay v + let nameHash = hashText v.DisplayNameCoreMangled + let typarHash = hashTyparDecls g tps + let argInfos, retTy = GetTopTauTypeInFSharpForm g valReprInfo.ArgInfos tau v.Range + let typeHash = hashTopType g argInfos retTy cxs + let flagsHash = hash v.val_flags.PickledBits + let attribsHash = hashAttributeList v.Attribs + + let combinedHash = nameHash @@ typarHash @@ typeHash @@ flagsHash @@ attribsHash + combinedHash + + let hashValOrMemberNoInst (g, obs) (vref: ValRef) = + match vref.MemberInfo with + | None -> + let tps, tau = vref.GeneralizedType + + let cxs = + tps + |> Seq.collect (fun tp -> tp.Constraints |> Seq.map (fun cx -> struct (tp, cx))) + + hashNonMemberVal (g, obs) (tps, vref.Deref, tau, cxs) + | Some _ -> hashMember (g, obs) emptyTyparInst vref.Deref diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 4a6bbf58d2f..bcd84b20b9b 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -622,6 +622,11 @@ Interoperabilita mezi neřízeným obecným omezením jazyka C# a F# (emitovat další modreq) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Metoda getter a setter indexované vlastnosti musí mít stejný typ. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 1546541aee7..7c17af906bd 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -622,6 +622,11 @@ Interop zwischen nicht verwalteter generischer Einschränkung in C# und F# (zusätzlicher ModReq ausgeben) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Getter und Setter für indizierte Eigenschaften müssen denselben Typ aufweisen. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index db357235565..6888785b209 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -622,6 +622,11 @@ Interoperabilidad entre la restricción genérica no administrada de C# y F# (emitir modreq adicional) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type El captador y el establecedor de propiedades indexadas deben tener el mismo tipo. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index dca6fe2b78d..5685be398f1 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -622,6 +622,11 @@ Interopérabilité entre les contraintes génériques non gérées de C# et F# (émettre un modreq supplémentaire) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Les propriétés indexées getter et setter doivent avoir le même type diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 0d2815aa9b2..0502559adb7 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -622,6 +622,11 @@ Interoperabilità tra il vincolo generico non gestito di C# e di F# (crea un modreq aggiuntivo) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Il getter e il setter delle proprietà indicizzate devono avere lo stesso tipo diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index d660cf6768b..91ec1fd4e52 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -622,6 +622,11 @@ C# と F# のアンマネージド ジェネリック制約の間の相互運用 (追加の modreq を出力) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type インデックス付きプロパティのゲッターとセッターの型は同じである必要があります diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index a0f3d1411b4..fcf2e6eb52f 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -622,6 +622,11 @@ C#과 F#의 관리되지 않는 제네릭 제약 조건 간의 Interop(추가 modreq 내보내기) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type 인덱싱된 속성 getter와 setter의 형식이 같아야 합니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index fcb2638d5a2..7e835a5a8ff 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -622,6 +622,11 @@ Międzyoperacyjnie między niezarządzanym ograniczeniem ogólnym języka C# i F# (emituj dodatkowe modreq) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Metoda pobierająca i metoda ustawiająca właściwości indeksowanych muszą mieć taki sam typ. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index a27487e1c20..78da4d876a6 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -622,6 +622,11 @@ Interoperabilidade entre a restrição genérica não gerenciada de C# e F# (emitir modreq adicional) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type As propriedades indexadas getter e setter devem ter o mesmo tipo diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 18c6c501759..812af0ab299 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -622,6 +622,11 @@ Взаимодействие между универсальным ограничением "unmanaged" C# и F#(создание дополнительного modreq) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Методы получения и установки индексированных свойств должны иметь один и тот же тип. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 94a7a284470..faf2ed181c4 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -622,6 +622,11 @@ C# ile F#' arasında yönetilmeyen genel kısıtlama (ek modreq yayın) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type Dizini oluşturulmuş özelliklerin alıcısı ve ayarlayıcısı aynı türde olmalıdır diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index ba5826eb686..c326b431454 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -622,6 +622,11 @@ C# 和 F# 的非托管泛型约束之间的互操作(发出额外的 modreq) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type 索引属性 getter 和 setter 必须具有相同的类型 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index b039caf9e93..e3edef16c69 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -622,6 +622,11 @@ C# 與 F# 的非受控泛型條件約束之間的 Interop (發出額外的 modreq) + + Use type conversion cache during compilation + Use type conversion cache during compilation + + Indexed properties getter and setter must have the same type 索引屬性 getter 和 setter 必須具有相同的類型