From a1a33168ba975e902c8ba3f86a66352c786d9901 Mon Sep 17 00:00:00 2001 From: Alex Berezhnykh Date: Thu, 11 Mar 2021 16:12:09 +0300 Subject: [PATCH] Provided Types virtualization (#2) --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Driver/CompilerImports.fs | 8 +- src/Compiler/TypedTree/TypeProviders.fs | 559 +++++++++++++++------ src/Compiler/TypedTree/TypeProviders.fsi | 307 ++++++----- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- src/Compiler/TypedTree/tainted.fs | 21 +- src/Compiler/TypedTree/tainted.fsi | 12 +- 7 files changed, 613 insertions(+), 298 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 0699c35ae5f..6c7f1ab8f92 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2855,7 +2855,7 @@ module EstablishTypeDefinitionCores = let ctxt = ProvidedTypeContext.Create(lookupILTypeRef, lookupTyconRef) // Create a new provided type which captures the reverse-remapping tables. - let theRootTypeWithRemapping = theRootType.PApply ((fun x -> ProvidedType.ApplyContext(x, ctxt)), m) + let theRootTypeWithRemapping = theRootType.PApply ((fun x -> x.ApplyContext(ctxt)), m) let isRootGenerated, rootProvAssemStaticLinkInfoOpt = let stRootAssembly = theRootTypeWithRemapping.PApply((fun st -> st.Assembly), m) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index d182a8d8ebf..1d38d3d4e7a 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -1884,13 +1884,7 @@ and [] TcImports // NOTE: The types provided by GetTypes() are available for name resolution // when the namespace is "opened". This is part of the specification of the language // feature. - let tys = - providedNamespace.PApplyArray((fun provider -> provider.GetTypes()), "GetTypes", m) - - let ptys = - [| - for ty in tys -> ty.PApply((fun ty -> ty |> ProvidedType.CreateNoContext), m) - |] + let ptys = providedNamespace.PApplyArray(GetProvidedTypes, "GetTypes", m) for st in ptys do tcImportsStrong.InjectProvidedNamespaceOrTypeIntoEntity( diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index dff177e296f..59c7f935b2f 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -2,7 +2,7 @@ // Type providers, validation of provided types, etc. -module internal rec FSharp.Compiler.TypeProviders +module rec FSharp.Compiler.TypeProviders #if !NO_TYPEPROVIDERS @@ -153,9 +153,8 @@ let CreateTypeProvider ( // No appropriate constructor found raise (TypeProviderError(FSComp.SR.etProviderDoesNotHaveValidConstructor(), typeProviderImplementationType.FullName, m)) -let GetTypeProvidersOfAssembly ( +let GetTypeProvidersOfAssemblyInternal ( runtimeAssemblyFilename: string, - ilScopeRefOfRuntimeAssembly: ILScopeRef, designTimeName: string, resolutionEnvironment: ResolutionEnvironment, isInvalidationSupported: bool, @@ -163,10 +162,11 @@ let GetTypeProvidersOfAssembly ( systemRuntimeContainsType: string -> bool, systemRuntimeAssemblyVersion: Version, compilerToolPaths: string list, + logError: TypeProviderError -> unit, m:range ) = - let providerSpecs = + let providers = try let designTimeAssemblyName = try @@ -194,18 +194,16 @@ let GetTypeProvidersOfAssembly ( isInteractive, systemRuntimeContainsType, systemRuntimeAssemblyVersion, m) match box resolver with | Null -> () - | _ -> yield (resolver, ilScopeRefOfRuntimeAssembly) + | _ -> yield resolver | None, _ -> () ] with :? TypeProviderError as tpe -> - tpe.Iter(fun e -> errorR(Error((e.Number, e.ContextualErrorMessage), m)) ) + logError tpe [] - let providers = Tainted<_>.CreateAll(providerSpecs) - providers let unmarshal (t: Tainted<_>) = t.PUntaintNoFailure id @@ -243,10 +241,6 @@ let TryMemberMember (mi: Tainted<_>, typeName, memberName, memberMemberName, m, tpe.Iter (fun e -> errorR(Error(FSComp.SR.etUnexpectedExceptionFromProvidedMemberMember(memberMemberName, typeName, memberName, e.ContextualErrorMessage), m))) mi.PApplyNoFailure(fun _ -> recover) -/// Get the string to show for the name of a type provider -let DisplayNameOfTypeProvider(resolver: Tainted, m: range) = - resolver.PUntaint((fun tp -> tp.GetType().Name), m) - /// Validate a provided namespace name let ValidateNamespaceName(name, typeProvider: Tainted, m, nsp: string MaybeNull) = match nsp with @@ -338,7 +332,7 @@ type ProvidedTypeContext = for KeyValue (st, tcref) in d2.Force() do dict.TryAdd(st, f tcref) |> ignore dict)) -[] +[] type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = inherit ProvidedMemberInfo(x, ctxt) @@ -347,13 +341,6 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = x.CustomAttributes |> Seq.exists (fun a -> a.Constructor.DeclaringType.FullName = typeof.FullName) - let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider - - interface IProvidedCustomAttributeProvider with - member _.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider - member _.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider - member _.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider - // The type provider spec distinguishes between // - calls that can be made on provided types (i.e. types given by ReturnType, ParameterType, and generic argument types) // - calls that can be made on provided type definitions (types returned by ResolveTypeName, GetTypes etc.) @@ -361,111 +348,158 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = // Alternatively we could use assertions to enforce this. // Suppress relocation of generated types - member _.IsSuppressRelocate = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 + abstract member IsSuppressRelocate: bool + default _.IsSuppressRelocate = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 - member _.IsErased = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 + abstract member IsErased: bool + default _.IsErased = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 - member _.IsGenericType = x.IsGenericType + abstract member IsGenericType: bool + default _.IsGenericType = x.IsGenericType - member _.Namespace : string MaybeNull = x.Namespace + abstract member Namespace: string + default _.Namespace : string MaybeNull = x.Namespace - member _.FullName = x.FullName + abstract member FullName: string + default _.FullName = x.FullName - member _.IsArray = x.IsArray + abstract member IsArray: bool + default _.IsArray = x.IsArray - member _.Assembly: ProvidedAssembly MaybeNull = x.Assembly |> ProvidedAssembly.Create + abstract member Assembly: ProvidedAssembly + default _.Assembly: ProvidedAssembly MaybeNull = x.Assembly |> ProvidedAssembly.Create - member _.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt + abstract member GetInterfaces: unit -> ProvidedType[] + default _.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt - member _.GetMethods() = x.GetMethods bindingFlags |> ProvidedMethodInfo.CreateArray ctxt + abstract member GetMethods: unit -> ProvidedMethodInfo[] + default _.GetMethods() = x.GetMethods bindingFlags |> ProvidedMethodInfo.CreateArray ctxt - member _.GetEvents() = x.GetEvents bindingFlags |> ProvidedEventInfo.CreateArray ctxt + abstract member GetEvents: unit -> ProvidedEventInfo[] + default _.GetEvents() = x.GetEvents bindingFlags |> ProvidedEventInfo.CreateArray ctxt - member _.GetEvent nm = x.GetEvent(nm, bindingFlags) |> ProvidedEventInfo.Create ctxt + abstract member GetEvent: nm: string -> ProvidedEventInfo + default _.GetEvent nm = x.GetEvent(nm, bindingFlags) |> ProvidedEventInfo.Create ctxt - member _.GetProperties() = x.GetProperties bindingFlags |> ProvidedPropertyInfo.CreateArray ctxt + abstract member GetProperties: unit -> ProvidedPropertyInfo[] + default _.GetProperties() = x.GetProperties bindingFlags |> ProvidedPropertyInfo.CreateArray ctxt - member _.GetProperty nm = x.GetProperty(nm, bindingFlags) |> ProvidedPropertyInfo.Create ctxt + abstract member GetProperty: string -> ProvidedPropertyInfo + default _.GetProperty nm = x.GetProperty(nm, bindingFlags) |> ProvidedPropertyInfo.Create ctxt - member _.GetConstructors() = x.GetConstructors bindingFlags |> ProvidedConstructorInfo.CreateArray ctxt + abstract member GetConstructors: unit -> ProvidedConstructorInfo[] + default _.GetConstructors() = x.GetConstructors bindingFlags |> ProvidedConstructorInfo.CreateArray ctxt - member _.GetFields() = x.GetFields bindingFlags |> ProvidedFieldInfo.CreateArray ctxt + abstract GetFields: unit -> ProvidedFieldInfo[] + default _.GetFields() = x.GetFields bindingFlags |> ProvidedFieldInfo.CreateArray ctxt - member _.GetField nm = x.GetField(nm, bindingFlags) |> ProvidedFieldInfo.Create ctxt + abstract GetField: nm: string -> ProvidedFieldInfo + default _.GetField nm = x.GetField(nm, bindingFlags) |> ProvidedFieldInfo.Create ctxt - member _.GetAllNestedTypes() = x.GetNestedTypes(bindingFlags ||| BindingFlags.NonPublic) |> ProvidedType.CreateArray ctxt + abstract member GetAllNestedTypes: unit -> ProvidedType[] + default _.GetAllNestedTypes() = x.GetNestedTypes(bindingFlags ||| BindingFlags.NonPublic) |> ProvidedType.CreateArray ctxt - member _.GetNestedTypes() = x.GetNestedTypes bindingFlags |> ProvidedType.CreateArray ctxt + abstract member GetNestedTypes: unit -> ProvidedType[] + default _.GetNestedTypes() = x.GetNestedTypes bindingFlags |> ProvidedType.CreateArray ctxt /// Type.GetNestedType(string) can return null if there is no nested type with given name - member _.GetNestedType nm = x.GetNestedType (nm, bindingFlags) |> ProvidedType.Create ctxt + abstract member GetNestedType: nm: string -> ProvidedType + default _.GetNestedType nm = x.GetNestedType (nm, bindingFlags) |> ProvidedType.Create ctxt /// Type.GetGenericTypeDefinition() either returns type or throws exception, null is not permitted - member _.GetGenericTypeDefinition() = x.GetGenericTypeDefinition() |> ProvidedType.CreateWithNullCheck ctxt "GenericTypeDefinition" + abstract member GetGenericTypeDefinition: unit -> ProvidedType + default _.GetGenericTypeDefinition() = x.GetGenericTypeDefinition() |> ProvidedType.CreateWithNullCheck ctxt "GenericTypeDefinition" /// Type.BaseType can be null when Type is interface or object - member _.BaseType = x.BaseType |> ProvidedType.Create ctxt + abstract member BaseType: ProvidedType + default _.BaseType = x.BaseType |> ProvidedType.Create ctxt - member _.GetStaticParameters(provider: ITypeProvider) = provider.GetStaticParameters x |> ProvidedParameterInfo.CreateArray ctxt + abstract member GetStaticParameters: ITypeProvider -> ProvidedParameterInfo[] + default _.GetStaticParameters(provider: ITypeProvider) = provider.GetStaticParameters x |> ProvidedParameterInfo.CreateArray ctxt /// Type.GetElementType can be null if i.e. Type is not array\pointer\byref type - member _.GetElementType() = x.GetElementType() |> ProvidedType.Create ctxt + abstract member GetElementType: unit -> ProvidedType + default _.GetElementType() = x.GetElementType() |> ProvidedType.Create ctxt - member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt + abstract member GetGenericArguments: unit -> ProvidedType[] + default _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt - member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = + abstract member ApplyStaticArguments: ITypeProvider * string[] * obj[] -> ProvidedType + default _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt - member _.IsVoid = (Type.op_Equality(x, typeof) || (x.Namespace = "System" && x.Name = "Void")) + abstract member IsVoid: bool + default _.IsVoid = (Type.op_Equality(x, typeof) || (x.Namespace = "System" && x.Name = "Void")) - member _.IsGenericParameter = x.IsGenericParameter + abstract member IsGenericParameter: bool + default _.IsGenericParameter = x.IsGenericParameter - member _.IsValueType = x.IsValueType + abstract member IsValueType: bool + default _.IsValueType = x.IsValueType - member _.IsByRef = x.IsByRef + abstract member IsByRef: bool + default _.IsByRef = x.IsByRef - member _.IsPointer = x.IsPointer + abstract member IsPointer: bool + default _.IsPointer = x.IsPointer - member _.IsPublic = x.IsPublic + abstract member IsPublic: bool + default _.IsPublic = x.IsPublic - member _.IsNestedPublic = x.IsNestedPublic + abstract member IsNestedPublic: bool + default _.IsNestedPublic = x.IsNestedPublic - member _.IsEnum = x.IsEnum + abstract member IsEnum: bool + default _.IsEnum = x.IsEnum - member _.IsClass = x.IsClass + abstract member IsClass: bool + default _.IsClass = x.IsClass - member _.IsMeasure = isMeasure.Value + abstract member IsMeasure: bool + default _.IsMeasure = isMeasure.Value - member _.IsSealed = x.IsSealed + abstract member IsSealed: bool + default _.IsSealed = x.IsSealed - member _.IsAbstract = x.IsAbstract + abstract member IsAbstract: bool + default _.IsAbstract = x.IsAbstract - member _.IsInterface = x.IsInterface + abstract member IsInterface: bool + default _.IsInterface = x.IsInterface - member _.GetArrayRank() = x.GetArrayRank() + abstract member GetArrayRank: unit -> int + default _.GetArrayRank() = x.GetArrayRank() - member _.GenericParameterPosition = x.GenericParameterPosition + abstract member GenericParameterPosition: int + default _.GenericParameterPosition = x.GenericParameterPosition member _.RawSystemType = x /// Type.GetEnumUnderlyingType either returns type or raises exception, null is not permitted - member _.GetEnumUnderlyingType() = + abstract member GetEnumUnderlyingType: unit -> ProvidedType + default _.GetEnumUnderlyingType() = x.GetEnumUnderlyingType() |> ProvidedType.CreateWithNullCheck ctxt "EnumUnderlyingType" - member _.MakePointerType() = ProvidedType.CreateNoContext(x.MakePointerType()) + abstract member MakePointerType: unit -> ProvidedType + default _.MakePointerType() = ProvidedType.CreateNoContext(x.MakePointerType()) - member _.MakeByRefType() = ProvidedType.CreateNoContext(x.MakeByRefType()) + abstract member MakeByRefType: unit -> ProvidedType + default _.MakeByRefType() = ProvidedType.CreateNoContext(x.MakeByRefType()) - member _.MakeArrayType() = ProvidedType.CreateNoContext(x.MakeArrayType()) + abstract member MakeArrayType: unit -> ProvidedType + default _.MakeArrayType() = ProvidedType.CreateNoContext(x.MakeArrayType()) - member _.MakeArrayType rank = ProvidedType.CreateNoContext(x.MakeArrayType(rank)) + abstract member MakeArrayType: rank: int -> ProvidedType + default _.MakeArrayType rank = ProvidedType.CreateNoContext(x.MakeArrayType(rank)) - member _.MakeGenericType (args: ProvidedType[]) = + abstract member MakeGenericType: args: ProvidedType[] -> ProvidedType + default _.MakeGenericType (args: ProvidedType[]) = let argTypes = args |> Array.map (fun arg -> arg.RawSystemType) ProvidedType.CreateNoContext(x.MakeGenericType(argTypes)) - member _.AsProvidedVar name = ProvidedVar.Create ctxt (Var(name, x)) + abstract member AsProvidedVar: name: string -> ProvidedVar + default _.AsProvidedVar name = ProvidedVar.Create ctxt (Var(name, x)) static member Create ctxt x = match x with null -> null | t -> ProvidedType (t, ctxt) @@ -483,19 +517,22 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) = override _.GetHashCode() = assert false; x.GetHashCode() - member _.Context = ctxt + abstract member Context: ProvidedTypeContext + default _.Context = ctxt member this.TryGetILTypeRef() = this.Context.TryGetILTypeRef this member this.TryGetTyconRef() = this.Context.TryGetTyconRef this - static member ApplyContext (pt: ProvidedType, ctxt) = ProvidedType(pt.Handle, ctxt) + abstract member ApplyContext: ProvidedTypeContext -> ProvidedType + default pt.ApplyContext ctxt = ProvidedType(pt.Handle, ctxt) - static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + static member TaintedEquals (pt1: Tainted, pt2: Tainted) = + Tainted.PhysicallyEqTainted (pt1.PApplyNoFailure(fun st -> (st.Assembly.FullName, st.FullName))) (pt2.PApplyNoFailure(fun st -> (st.Assembly.FullName, st.FullName))) [] type IProvidedCustomAttributeProvider = + abstract GetCustomAttributes : provider: ITypeProvider -> seq abstract GetDefinitionLocationAttribute: provider: ITypeProvider -> (string * int * int) option abstract GetXmlDocAttributes: provider: ITypeProvider -> string[] abstract GetHasTypeProviderEditorHideMethodsAttribute: provider: ITypeProvider -> bool @@ -507,6 +544,8 @@ type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq Seq.tryFind (findAttribByName attribName) @@ -549,59 +588,104 @@ type ProvidedCustomAttributeProvider (attributes :ITypeProvider -> seq x.CustomAttributes) :> IProvidedCustomAttributeProvider - member _.Name = x.Name + abstract member Name: string + default _.Name = x.Name /// DeclaringType can be null if MemberInfo belongs to Module, not to Type - member _.DeclaringType = ProvidedType.Create ctxt x.DeclaringType + abstract member DeclaringType: ProvidedType + default _.DeclaringType = ProvidedType.Create ctxt x.DeclaringType + + abstract GetCustomAttributes : provider: ITypeProvider -> seq + default _.GetCustomAttributes provider = + provide().GetCustomAttributes provider + + abstract GetHasTypeProviderEditorHideMethodsAttribute : provider:ITypeProvider -> bool + default _.GetHasTypeProviderEditorHideMethodsAttribute provider = + provide().GetHasTypeProviderEditorHideMethodsAttribute provider + + abstract GetDefinitionLocationAttribute : provider:ITypeProvider -> (string * int * int) option + default _.GetDefinitionLocationAttribute provider = + provide().GetDefinitionLocationAttribute provider + + abstract GetXmlDocAttributes : provider: ITypeProvider -> string[] + default _.GetXmlDocAttributes provider = + provide().GetXmlDocAttributes provider + + abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option + default _.GetAttributeConstructorArgs (provider, attribName) = + provide().GetAttributeConstructorArgs (provider, attribName) interface IProvidedCustomAttributeProvider with - member _.GetHasTypeProviderEditorHideMethodsAttribute provider = - provide().GetHasTypeProviderEditorHideMethodsAttribute provider + member this.GetCustomAttributes provider = this.GetCustomAttributes provider - member _.GetDefinitionLocationAttribute provider = - provide().GetDefinitionLocationAttribute provider + member this.GetHasTypeProviderEditorHideMethodsAttribute provider = this.GetHasTypeProviderEditorHideMethodsAttribute provider - member _.GetXmlDocAttributes provider = - provide().GetXmlDocAttributes provider + member this.GetDefinitionLocationAttribute provider = this.GetDefinitionLocationAttribute provider - member _.GetAttributeConstructorArgs (provider, attribName) = - provide().GetAttributeConstructorArgs (provider, attribName) + member this.GetXmlDocAttributes provider = this.GetXmlDocAttributes provider -[] + member this.GetAttributeConstructorArgs (provider, attribName) = this.GetAttributeConstructorArgs (provider, attribName) + +[] type ProvidedParameterInfo (x: ParameterInfo, ctxt) = let provide () = ProvidedCustomAttributeProvider (fun _ -> x.CustomAttributes) :> IProvidedCustomAttributeProvider - member _.Name = x.Name + abstract member Name: string + default _.Name = x.Name - member _.IsOut = x.IsOut + abstract member IsOut: bool + default _.IsOut = x.IsOut - member _.IsIn = x.IsIn + abstract member IsIn: bool + default _.IsIn = x.IsIn - member _.IsOptional = x.IsOptional + abstract member IsOptional: bool + default _.IsOptional = x.IsOptional - member _.RawDefaultValue = x.RawDefaultValue + abstract member RawDefaultValue: obj + default _.RawDefaultValue = x.RawDefaultValue - member _.HasDefaultValue = x.Attributes.HasFlag(ParameterAttributes.HasDefault) + abstract member HasDefaultValue: bool + default _.HasDefaultValue = x.Attributes.HasFlag(ParameterAttributes.HasDefault) /// ParameterInfo.ParameterType cannot be null - member _.ParameterType = ProvidedType.CreateWithNullCheck ctxt "ParameterType" x.ParameterType + abstract member ParameterType: ProvidedType + default _.ParameterType = ProvidedType.CreateWithNullCheck ctxt "ParameterType" x.ParameterType static member Create ctxt x = match x with null -> null | t -> ProvidedParameterInfo (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedParameterInfo.Create ctxt) // TODO null wrong? + abstract GetCustomAttributes : provider: ITypeProvider -> seq + default _.GetCustomAttributes provider = + provide().GetCustomAttributes provider + + abstract GetHasTypeProviderEditorHideMethodsAttribute : provider:ITypeProvider -> bool + default _.GetHasTypeProviderEditorHideMethodsAttribute provider = + provide().GetHasTypeProviderEditorHideMethodsAttribute provider + + abstract GetDefinitionLocationAttribute : provider:ITypeProvider -> (string * int * int) option + default _.GetDefinitionLocationAttribute provider = + provide().GetDefinitionLocationAttribute provider + + abstract GetXmlDocAttributes : provider: ITypeProvider -> string[] + default _.GetXmlDocAttributes provider = + provide().GetXmlDocAttributes provider + + abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option + default _.GetAttributeConstructorArgs (provider, attribName) = + provide().GetAttributeConstructorArgs (provider, attribName) + interface IProvidedCustomAttributeProvider with - member _.GetHasTypeProviderEditorHideMethodsAttribute provider = - provide().GetHasTypeProviderEditorHideMethodsAttribute provider + member this.GetCustomAttributes provider = this.GetCustomAttributes provider + + member this.GetHasTypeProviderEditorHideMethodsAttribute provider = this.GetHasTypeProviderEditorHideMethodsAttribute provider - member _.GetDefinitionLocationAttribute provider = - provide().GetDefinitionLocationAttribute provider + member this.GetDefinitionLocationAttribute provider = this.GetDefinitionLocationAttribute provider - member _.GetXmlDocAttributes provider = - provide().GetXmlDocAttributes provider + member this.GetXmlDocAttributes provider = this.GetXmlDocAttributes provider - member _.GetAttributeConstructorArgs (provider, attribName) = - provide().GetAttributeConstructorArgs (provider, attribName) + member this.GetAttributeConstructorArgs (provider, attribName) = this.GetAttributeConstructorArgs (provider, attribName) member _.Handle = x @@ -609,14 +693,17 @@ type ProvidedParameterInfo (x: ParameterInfo, ctxt) = override _.GetHashCode() = assert false; x.GetHashCode() -[] +[] type ProvidedAssembly (x: Assembly) = - member _.GetName() = x.GetName() + abstract member GetName : unit -> AssemblyName + default _.GetName() = x.GetName() - member _.FullName = x.FullName + abstract member FullName : string + default _.FullName = x.FullName - member _.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x + abstract member GetManifestModuleContents : ITypeProvider -> byte[] + default _.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x static member Create (x: Assembly) = match x with null -> null | t -> ProvidedAssembly t @@ -632,31 +719,44 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = member _.Context = ctxt - member _.IsGenericMethod = x.IsGenericMethod + abstract member IsGenericMethod: bool + default _.IsGenericMethod = x.IsGenericMethod - member _.IsStatic = x.IsStatic + abstract member IsStatic: bool + default _.IsStatic = x.IsStatic - member _.IsFamily = x.IsFamily + abstract member IsFamily: bool + default _.IsFamily = x.IsFamily - member _.IsFamilyOrAssembly = x.IsFamilyOrAssembly + abstract member IsFamilyOrAssembly: bool + default _.IsFamilyOrAssembly = x.IsFamilyOrAssembly - member _.IsFamilyAndAssembly = x.IsFamilyAndAssembly + abstract member IsFamilyAndAssembly: bool + default _.IsFamilyAndAssembly = x.IsFamilyAndAssembly - member _.IsVirtual = x.IsVirtual + abstract member IsVirtual: bool + default _.IsVirtual = x.IsVirtual - member _.IsFinal = x.IsFinal + abstract member IsFinal: bool + default _.IsFinal = x.IsFinal - member _.IsPublic = x.IsPublic + abstract member IsPublic: bool + default _.IsPublic = x.IsPublic - member _.IsAbstract = x.IsAbstract + abstract member IsAbstract: bool + default _.IsAbstract = x.IsAbstract - member _.IsHideBySig = x.IsHideBySig + abstract member IsHideBySig: bool + default _.IsHideBySig = x.IsHideBySig - member _.IsConstructor = x.IsConstructor + abstract member IsConstructor: bool + default _.IsConstructor = x.IsConstructor - member _.GetParameters() = x.GetParameters() |> ProvidedParameterInfo.CreateArray ctxt + abstract member GetParameters: unit -> ProvidedParameterInfo[] + default _.GetParameters() = x.GetParameters() |> ProvidedParameterInfo.CreateArray ctxt - member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt + abstract member GetGenericArguments: unit -> ProvidedType[] + default _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt member _.Handle = x @@ -664,9 +764,10 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = Tainted.GetHashCodeTainted (x.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + Tainted.PhysicallyEqTainted (pt1.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) (pt2.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) - member _.GetStaticParametersForMethod(provider: ITypeProvider) = + abstract GetStaticParametersForMethod: provider: ITypeProvider -> ProvidedParameterInfo[] + default _.GetStaticParametersForMethod(provider: ITypeProvider) = let bindingFlags = BindingFlags.Instance ||| BindingFlags.NonPublic ||| BindingFlags.Public let staticParams = @@ -687,7 +788,8 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = staticParams |> ProvidedParameterInfo.CreateArray ctxt - member _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: obj[]) = + abstract member ApplyStaticArgumentsForMethod : provider: ITypeProvider * fullNameAfterArguments: string * staticArgs: obj[] -> ProvidedMethodBase + default _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: obj[]) = let bindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.InvokeMethod let mb = @@ -717,7 +819,7 @@ type ProvidedMethodBase (x: MethodBase, ctxt) = | _ -> failwith (FSComp.SR.estApplyStaticArgumentsForMethodNotImplemented()) -[] +[] type ProvidedFieldInfo (x: FieldInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) @@ -725,44 +827,55 @@ type ProvidedFieldInfo (x: FieldInfo, ctxt) = static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedFieldInfo.Create ctxt) - member _.IsInitOnly = x.IsInitOnly + abstract member IsInitOnly: bool + default _.IsInitOnly = x.IsInitOnly - member _.IsStatic = x.IsStatic + abstract member IsStatic: bool + default _.IsStatic = x.IsStatic - member _.IsSpecialName = x.IsSpecialName + abstract member IsSpecialName: bool + default _.IsSpecialName = x.IsSpecialName - member _.IsLiteral = x.IsLiteral + abstract member IsLiteral: bool + default _.IsLiteral = x.IsLiteral - member _.GetRawConstantValue() = x.GetRawConstantValue() + abstract member GetRawConstantValue: unit -> obj + default _.GetRawConstantValue() = x.GetRawConstantValue() /// FieldInfo.FieldType cannot be null - - member _.FieldType = x.FieldType |> ProvidedType.CreateWithNullCheck ctxt "FieldType" + abstract member FieldType: ProvidedType + default _.FieldType = x.FieldType |> ProvidedType.CreateWithNullCheck ctxt "FieldType" member _.Handle = x - member _.IsPublic = x.IsPublic + abstract member IsPublic: bool + default _.IsPublic = x.IsPublic - member _.IsFamily = x.IsFamily + abstract member IsFamily: bool + default _.IsFamily = x.IsFamily - member _.IsPrivate = x.IsPrivate + abstract member IsPrivate: bool + default _.IsPrivate = x.IsPrivate - member _.IsFamilyOrAssembly = x.IsFamilyOrAssembly + abstract member IsFamilyOrAssembly: bool + default _.IsFamilyOrAssembly = x.IsFamilyOrAssembly - member _.IsFamilyAndAssembly = x.IsFamilyAndAssembly + abstract member IsFamilyAndAssembly: bool + default _.IsFamilyAndAssembly = x.IsFamilyAndAssembly override _.Equals y = assert false; match y with :? ProvidedFieldInfo as y -> x.Equals y.Handle | _ -> false override _.GetHashCode() = assert false; x.GetHashCode() static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + Tainted.PhysicallyEqTainted (pt1.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) (pt2.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) -[] +[] type ProvidedMethodInfo (x: MethodInfo, ctxt) = inherit ProvidedMethodBase(x, ctxt) - member _.ReturnType = x.ReturnType |> ProvidedType.CreateWithNullCheck ctxt "ReturnType" + abstract member ReturnType: ProvidedType + default _.ReturnType = x.ReturnType |> ProvidedType.CreateWithNullCheck ctxt "ReturnType" static member Create ctxt x = match x with null -> null | t -> ProvidedMethodInfo (t, ctxt) @@ -770,28 +883,35 @@ type ProvidedMethodInfo (x: MethodInfo, ctxt) = member _.Handle = x - member _.MetadataToken = x.MetadataToken + abstract member MetadataToken: int + default _.MetadataToken = x.MetadataToken override _.Equals y = assert false; match y with :? ProvidedMethodInfo as y -> x.Equals y.Handle | _ -> false override _.GetHashCode() = assert false; x.GetHashCode() -[] +[] type ProvidedPropertyInfo (x: PropertyInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) - member _.GetGetMethod() = x.GetGetMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetGetMethod: unit -> ProvidedMethodInfo + default _.GetGetMethod() = x.GetGetMethod() |> ProvidedMethodInfo.Create ctxt - member _.GetSetMethod() = x.GetSetMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetSetMethod: unit -> ProvidedMethodInfo + default _.GetSetMethod() = x.GetSetMethod() |> ProvidedMethodInfo.Create ctxt - member _.CanRead = x.CanRead + abstract member CanRead: bool + default _.CanRead = x.CanRead - member _.CanWrite = x.CanWrite + abstract member CanWrite: bool + default _.CanWrite = x.CanWrite - member _.GetIndexParameters() = x.GetIndexParameters() |> ProvidedParameterInfo.CreateArray ctxt + abstract member GetIndexParameters: unit -> ProvidedParameterInfo[] + default _.GetIndexParameters() = x.GetIndexParameters() |> ProvidedParameterInfo.CreateArray ctxt /// PropertyInfo.PropertyType cannot be null - member _.PropertyType = x.PropertyType |> ProvidedType.CreateWithNullCheck ctxt "PropertyType" + abstract member PropertyType: ProvidedType + default _.PropertyType = x.PropertyType |> ProvidedType.CreateWithNullCheck ctxt "PropertyType" static member Create ctxt x = match x with null -> null | t -> ProvidedPropertyInfo (t, ctxt) @@ -807,18 +927,21 @@ type ProvidedPropertyInfo (x: PropertyInfo, ctxt) = Tainted.GetHashCodeTainted (x.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + Tainted.PhysicallyEqTainted (pt1.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) (pt2.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) -[] +[] type ProvidedEventInfo (x: EventInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) - member _.GetAddMethod() = x.GetAddMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetAddMethod: unit -> ProvidedMethodInfo + default _.GetAddMethod() = x.GetAddMethod() |> ProvidedMethodInfo.Create ctxt - member _.GetRemoveMethod() = x.GetRemoveMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetRemoveMethod: unit -> ProvidedMethodInfo + default _.GetRemoveMethod() = x.GetRemoveMethod() |> ProvidedMethodInfo.Create ctxt /// EventInfo.EventHandlerType cannot be null - member _.EventHandlerType = x.EventHandlerType |> ProvidedType.CreateWithNullCheck ctxt "EventHandlerType" + abstract member EventHandlerType: ProvidedType + default _.EventHandlerType = x.EventHandlerType |> ProvidedType.CreateWithNullCheck ctxt "EventHandlerType" static member Create ctxt x = match x with null -> null | t -> ProvidedEventInfo (t, ctxt) @@ -834,9 +957,9 @@ type ProvidedEventInfo (x: EventInfo, ctxt) = Tainted.GetHashCodeTainted (x.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + Tainted.PhysicallyEqTainted (pt1.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) (pt2.PApplyNoFailure(fun st -> (st.Name, st.DeclaringType.Assembly.FullName, st.DeclaringType.FullName))) -[] +[] type ProvidedConstructorInfo (x: ConstructorInfo, ctxt) = inherit ProvidedMethodBase(x, ctxt) @@ -875,18 +998,21 @@ type ProvidedExprType = | ProvidedIfThenElseExpr of ProvidedExpr * ProvidedExpr * ProvidedExpr | ProvidedVarExpr of ProvidedVar -[] +[] type ProvidedExpr (x: Expr, ctxt) = - member _.Type = x.Type |> ProvidedType.Create ctxt + abstract member Type: ProvidedType + default _.Type = x.Type |> ProvidedType.Create ctxt member _.Handle = x member _.Context = ctxt - member _.UnderlyingExpressionString = x.ToString() + abstract member UnderlyingExpressionString: string + default _.UnderlyingExpressionString = x.ToString() - member _.GetExprType() = + abstract member GetExprType: unit -> ProvidedExprType option + default _.GetExprType() = match x with | Patterns.NewObject(ctor, args) -> Some (ProvidedNewObjectExpr (ProvidedConstructorInfo.Create ctxt ctor, [| for a in args -> ProvidedExpr.Create ctxt a |])) @@ -942,21 +1068,134 @@ type ProvidedExpr (x: Expr, ctxt) = override _.GetHashCode() = x.GetHashCode() -[] +[] type ProvidedVar (x: Var, ctxt) = - member _.Type = x.Type |> ProvidedType.Create ctxt - member _.Name = x.Name - member _.IsMutable = x.IsMutable + abstract member Type: ProvidedType + default _.Type = x.Type |> ProvidedType.Create ctxt + abstract member Name: string + default _.Name = x.Name + abstract member IsMutable: bool + default _.IsMutable = x.IsMutable member _.Handle = x member _.Context = ctxt static member Create ctxt t = match box t with null -> null | _ -> ProvidedVar (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedVar.Create ctxt) - override _.Equals y = match y with :? ProvidedVar as y -> x.Equals y.Handle | _ -> false - override _.GetHashCode() = x.GetHashCode() + override this.Equals y = + match y with + | :? ProvidedVar as y -> this.Name.Equals y.Name && this.IsMutable = y.IsMutable && + (ProvidedTypeComparer.Instance :> IEqualityComparer<_>).Equals(this.Type, y.Type) + | _ -> false + + override this.GetHashCode() = this.Name.GetHashCode() + +[] +module Shim = + + type IExtensionTypingProvider = + abstract InstantiateTypeProvidersOfAssembly: + runtimeAssemblyFilename: string + * designerAssemblyName: string + * resolutionEnvironment: ResolutionEnvironment + * isInvalidationSupported: bool + * isInteractive: bool + * systemRuntimeContainsType: (string -> bool) + * systemRuntimeAssemblyVersion: System.Version + * compilerToolsPath: string list + * logError: (TypeProviderError -> unit) + * m: range -> ITypeProvider list + + abstract GetProvidedTypes: pn: IProvidedNamespace -> ProvidedType[] + abstract ResolveTypeName: pn: IProvidedNamespace * typeName: string -> ProvidedType + abstract GetInvokerExpression: provider: ITypeProvider * methodBase: ProvidedMethodBase * paramExprs: ProvidedVar[] -> ProvidedExpr + abstract DisplayNameOfTypeProvider: typeProvider: ITypeProvider * fullName: bool -> string + + [] + type DefaultExtensionTypingProvider() = + interface IExtensionTypingProvider with + member this.InstantiateTypeProvidersOfAssembly + (runTimeAssemblyFileName: string, + designTimeAssemblyNameString: string, + resolutionEnvironment: ResolutionEnvironment, + isInvalidationSupported: bool, + isInteractive: bool, + systemRuntimeContainsType: string -> bool, + systemRuntimeAssemblyVersion: System.Version, + compilerToolPaths: string list, + logError: TypeProviderError -> unit, + m: range) = + + GetTypeProvidersOfAssemblyInternal + (runTimeAssemblyFileName, + designTimeAssemblyNameString, + resolutionEnvironment, + isInvalidationSupported, + isInteractive, + systemRuntimeContainsType, + systemRuntimeAssemblyVersion, + compilerToolPaths, + logError, + m) + + member this.GetProvidedTypes(pn: IProvidedNamespace) = + pn.GetTypes() |> Array.map ProvidedType.CreateNoContext + + member this.ResolveTypeName(pn: IProvidedNamespace, typeName: string) = + pn.ResolveTypeName typeName |> ProvidedType.CreateNoContext + + member this.GetInvokerExpression(provider: ITypeProvider, methodBase: ProvidedMethodBase, paramExprs: ProvidedVar[]) = + provider.GetInvokerExpression(methodBase.Handle, [| for p in paramExprs -> Quotations.Expr.Var (p.Handle) |]) |> ProvidedExpr.Create methodBase.Context + + member this.DisplayNameOfTypeProvider(tp: ITypeProvider, fullName: bool) = + if fullName then tp.GetType().FullName else tp.GetType().Name + + [] + type ExtensionTyping() = + static let mutable provider = DefaultExtensionTypingProvider() :> IExtensionTypingProvider + static member Provider + with get() = provider + and set p = provider <- p + + let shimLogger (tpe: TypeProviderError) = + tpe.Iter(fun e -> errorR(Error((e.Number, e.ContextualErrorMessage), e.Range))) + + +let GetTypeProvidersOfAssembly + (runtimeAssemblyFilename: string, + ilScopeRefOfRuntimeAssembly: ILScopeRef, + designTimeName: string, + resolutionEnvironment: ResolutionEnvironment, + isInvalidationSupported: bool, + isInteractive: bool, + systemRuntimeContainsType : string -> bool, + systemRuntimeAssemblyVersion : System.Version, + compilerToolPaths: string list, + m: range) = + + let providers = ExtensionTyping.Provider.InstantiateTypeProvidersOfAssembly( + runtimeAssemblyFilename, + designTimeName, + resolutionEnvironment, + isInvalidationSupported, + isInteractive, + systemRuntimeContainsType, + systemRuntimeAssemblyVersion, + compilerToolPaths, + Shim.shimLogger, + m) + + Tainted<_>.CreateAll (providers |> List.map (fun p -> p, ilScopeRefOfRuntimeAssembly, ExtensionTyping.Provider.DisplayNameOfTypeProvider(p, true))) /// Get the provided invoker expression for a particular use of a method. let GetInvokerExpression (provider: ITypeProvider, methodBase: ProvidedMethodBase, paramExprs: ProvidedVar[]) = - provider.GetInvokerExpression(methodBase.Handle, [| for p in paramExprs -> Expr.Var p.Handle |]) |> ProvidedExpr.Create methodBase.Context + ExtensionTyping.Provider.GetInvokerExpression(provider, methodBase, paramExprs) + +/// Get all provided types from provided namespace +let GetProvidedTypes (pn: IProvidedNamespace) = + ExtensionTyping.Provider.GetProvidedTypes(pn) + +// Get the string to show for the name of a type provider +let DisplayNameOfTypeProvider (resolver: Tainted, m: range) = + resolver.PUntaint((fun tp -> ExtensionTyping.Provider.DisplayNameOfTypeProvider(tp, false)), m) /// Compute the Name or FullName property of a provided type, reporting appropriate errors let CheckAndComputeProvidedNameProperty(m, st: Tainted, proj, propertyString) = @@ -1148,7 +1387,7 @@ let ResolveProvidedType (resolver: Tainted, m, moduleOrNamespace: // Check if the provided namespace name is an exact match of the required namespace name if displayName = providedNamespaceName then - let resolvedType = providedNamespace.PApply((fun providedNamespace -> ProvidedType.CreateNoContext(providedNamespace.ResolveTypeName typeName)), range=m) + let resolvedType = providedNamespace.PApply((fun providedNamespace -> ExtensionTyping.Provider.ResolveTypeName(providedNamespace, typeName)), range=m) match resolvedType with | Tainted.Null -> None | Tainted.NonNull result -> diff --git a/src/Compiler/TypedTree/TypeProviders.fsi b/src/Compiler/TypedTree/TypeProviders.fsi index b1e3ccaf85c..e011400419a 100755 --- a/src/Compiler/TypedTree/TypeProviders.fsi +++ b/src/Compiler/TypedTree/TypeProviders.fsi @@ -2,13 +2,14 @@ // Extension typing, validation of extension types, etc. -module internal rec FSharp.Compiler.TypeProviders +module rec FSharp.Compiler.TypeProviders #if !NO_TYPEPROVIDERS open System open System.Collections.Concurrent open System.Collections.Generic +open System.Reflection open FSharp.Core.CompilerServices open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.Text @@ -90,103 +91,104 @@ type ProvidedTypeContext = /// Map the TyconRef objects, if any member RemapTyconRefs: (obj -> obj) -> ProvidedTypeContext -[] +[] type ProvidedType = + new: x: System.Type * ctxt: ProvidedTypeContext -> ProvidedType inherit ProvidedMemberInfo - member IsSuppressRelocate: bool + abstract member IsSuppressRelocate: bool - member IsErased: bool + abstract member IsErased: bool - member IsGenericType: bool + abstract member IsGenericType: bool - member Namespace: string + abstract member Namespace: string - member FullName: string + abstract member FullName: string - member IsArray: bool + abstract member IsArray: bool - member GetInterfaces: unit -> ProvidedType[] + abstract member GetInterfaces: unit -> ProvidedType[] - member Assembly: ProvidedAssembly + abstract member Assembly: ProvidedAssembly - member BaseType: ProvidedType + abstract member BaseType: ProvidedType - member GetNestedType: string -> ProvidedType + abstract member GetNestedType: string -> ProvidedType - member GetNestedTypes: unit -> ProvidedType[] + abstract member GetNestedTypes: unit -> ProvidedType[] - member GetAllNestedTypes: unit -> ProvidedType[] + abstract member GetAllNestedTypes: unit -> ProvidedType[] - member GetMethods: unit -> ProvidedMethodInfo[] + abstract member GetMethods: unit -> ProvidedMethodInfo[] - member GetFields: unit -> ProvidedFieldInfo[] + abstract member GetFields: unit -> ProvidedFieldInfo[] - member GetField: string -> ProvidedFieldInfo + abstract member GetField: string -> ProvidedFieldInfo - member GetProperties: unit -> ProvidedPropertyInfo[] + abstract member GetProperties: unit -> ProvidedPropertyInfo[] - member GetProperty: string -> ProvidedPropertyInfo + abstract member GetProperty: string -> ProvidedPropertyInfo - member GetEvents: unit -> ProvidedEventInfo[] + abstract member GetEvents: unit -> ProvidedEventInfo[] - member GetEvent: string -> ProvidedEventInfo + abstract member GetEvent: string -> ProvidedEventInfo - member GetConstructors: unit -> ProvidedConstructorInfo[] + abstract member GetConstructors: unit -> ProvidedConstructorInfo[] - member GetStaticParameters: ITypeProvider -> ProvidedParameterInfo[] + abstract member GetStaticParameters: ITypeProvider -> ProvidedParameterInfo[] - member GetGenericTypeDefinition: unit -> ProvidedType + abstract member GetGenericTypeDefinition: unit -> ProvidedType - member IsVoid: bool + abstract member IsVoid: bool - member IsGenericParameter: bool + abstract member IsGenericParameter: bool - member IsValueType: bool + abstract member IsValueType: bool - member IsByRef: bool + abstract member IsByRef: bool - member IsPointer: bool + abstract member IsPointer: bool - member IsEnum: bool + abstract member IsEnum: bool - member IsInterface: bool + abstract member IsInterface: bool - member IsClass: bool + abstract member IsClass: bool - member IsMeasure: bool + abstract member IsMeasure: bool - member IsSealed: bool + abstract member IsSealed: bool - member IsAbstract: bool + abstract member IsAbstract: bool - member IsPublic: bool + abstract member IsPublic: bool - member IsNestedPublic: bool + abstract member IsNestedPublic: bool - member GenericParameterPosition: int + abstract member GenericParameterPosition: int - member GetElementType: unit -> ProvidedType + abstract member GetElementType: unit -> ProvidedType - member GetGenericArguments: unit -> ProvidedType[] + abstract member GetGenericArguments: unit -> ProvidedType[] - member GetArrayRank: unit -> int + abstract member GetArrayRank: unit -> int member RawSystemType: Type - member GetEnumUnderlyingType: unit -> ProvidedType + abstract member GetEnumUnderlyingType: unit -> ProvidedType - member MakePointerType: unit -> ProvidedType + abstract member MakePointerType: unit -> ProvidedType - member MakeByRefType: unit -> ProvidedType + abstract member MakeByRefType: unit -> ProvidedType - member MakeArrayType: unit -> ProvidedType + abstract member MakeArrayType: unit -> ProvidedType - member MakeArrayType: rank: int -> ProvidedType + abstract member MakeArrayType: rank: int -> ProvidedType - member MakeGenericType: args: ProvidedType[] -> ProvidedType + abstract member MakeGenericType: args: ProvidedType[] -> ProvidedType - member AsProvidedVar: name: string -> ProvidedVar + abstract member AsProvidedVar: name: string -> ProvidedVar static member Void: ProvidedType @@ -196,16 +198,17 @@ type ProvidedType = member TryGetTyconRef: unit -> obj option - static member ApplyContext: ProvidedType * ProvidedTypeContext -> ProvidedType + abstract member ApplyContext: ProvidedTypeContext -> ProvidedType - member Context: ProvidedTypeContext - - interface IProvidedCustomAttributeProvider + abstract member Context: ProvidedTypeContext static member TaintedEquals: Tainted * Tainted -> bool + abstract member ApplyStaticArguments: ITypeProvider * string [] * obj [] -> ProvidedType + [] type IProvidedCustomAttributeProvider = + abstract GetCustomAttributes: provider: ITypeProvider -> seq abstract GetHasTypeProviderEditorHideMethodsAttribute: provider: ITypeProvider -> bool @@ -216,23 +219,34 @@ type IProvidedCustomAttributeProvider = abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option -[] +[] type ProvidedAssembly = + new: x: System.Reflection.Assembly -> ProvidedAssembly - member GetName: unit -> System.Reflection.AssemblyName + abstract member GetName: unit -> System.Reflection.AssemblyName - member FullName: string + abstract member FullName: string - member GetManifestModuleContents: ITypeProvider -> byte[] + abstract member GetManifestModuleContents: ITypeProvider -> byte[] member Handle: System.Reflection.Assembly [] type ProvidedMemberInfo = - member Name: string + abstract member Name: string + + abstract member DeclaringType: ProvidedType + + abstract GetCustomAttributes : provider: ITypeProvider -> seq - member DeclaringType: ProvidedType + abstract GetHasTypeProviderEditorHideMethodsAttribute : provider:ITypeProvider -> bool + + abstract GetDefinitionLocationAttribute : provider:ITypeProvider -> (string * int * int) option + + abstract GetXmlDocAttributes : provider:ITypeProvider -> string[] + + abstract GetAttributeConstructorArgs: provider:ITypeProvider * attribName:string -> (obj option list * (string * obj option) list) option interface IProvidedCustomAttributeProvider @@ -241,133 +255,156 @@ type ProvidedMethodBase = inherit ProvidedMemberInfo - member IsGenericMethod: bool + member Context: ProvidedTypeContext + + abstract member IsGenericMethod: bool - member IsStatic: bool + abstract member IsStatic: bool - member IsFamily: bool + abstract member IsFamily: bool - member IsFamilyAndAssembly: bool + abstract member IsFamilyAndAssembly: bool - member IsFamilyOrAssembly: bool + abstract member IsFamilyOrAssembly: bool - member IsVirtual: bool + abstract member IsVirtual: bool - member IsFinal: bool + abstract member IsFinal: bool - member IsPublic: bool + abstract member IsPublic: bool - member IsAbstract: bool + abstract member IsAbstract: bool - member IsHideBySig: bool + abstract member IsHideBySig: bool - member IsConstructor: bool + abstract member IsConstructor: bool - member GetParameters: unit -> ProvidedParameterInfo[] + abstract member GetParameters: unit -> ProvidedParameterInfo[] - member GetGenericArguments: unit -> ProvidedType[] + abstract member GetGenericArguments: unit -> ProvidedType[] - member GetStaticParametersForMethod: ITypeProvider -> ProvidedParameterInfo[] + abstract member GetStaticParametersForMethod: ITypeProvider -> ProvidedParameterInfo [] + + abstract member ApplyStaticArgumentsForMethod: + provider: ITypeProvider * fullNameAfterArguments: string * staticArgs: obj [] -> ProvidedMethodBase static member TaintedGetHashCode: Tainted -> int static member TaintedEquals: Tainted * Tainted -> bool -[] +[] type ProvidedMethodInfo = + new: x: System.Reflection.MethodInfo * ctxt: ProvidedTypeContext -> ProvidedMethodInfo inherit ProvidedMethodBase - member ReturnType: ProvidedType + abstract member ReturnType: ProvidedType + + abstract member MetadataToken: int - member MetadataToken: int + member Handle: System.Reflection.MethodInfo -[] +[] type ProvidedParameterInfo = + new: x: System.Reflection.ParameterInfo * ctxt: ProvidedTypeContext -> ProvidedParameterInfo + + abstract member Name: string + + abstract member ParameterType: ProvidedType + + abstract member IsIn: bool - member Name: string + abstract member IsOut: bool - member ParameterType: ProvidedType + abstract member IsOptional: bool - member IsIn: bool + abstract member RawDefaultValue: obj - member IsOut: bool + abstract member HasDefaultValue: bool - member IsOptional: bool + abstract GetCustomAttributes : provider: ITypeProvider -> seq - member RawDefaultValue: obj + abstract GetHasTypeProviderEditorHideMethodsAttribute : provider:ITypeProvider -> bool - member HasDefaultValue: bool + abstract GetDefinitionLocationAttribute : provider:ITypeProvider -> (string * int * int) option + + abstract GetXmlDocAttributes : provider:ITypeProvider -> string[] + + abstract GetAttributeConstructorArgs: provider:ITypeProvider * attribName:string -> (obj option list * (string * obj option) list) option interface IProvidedCustomAttributeProvider -[] +[] type ProvidedFieldInfo = + new: x: System.Reflection.FieldInfo * ctxt: ProvidedTypeContext -> ProvidedFieldInfo inherit ProvidedMemberInfo - member IsInitOnly: bool + abstract member IsInitOnly: bool - member IsStatic: bool + abstract member IsStatic: bool - member IsSpecialName: bool + abstract member IsSpecialName: bool - member IsLiteral: bool + abstract member IsLiteral: bool - member GetRawConstantValue: unit -> obj + abstract member GetRawConstantValue: unit -> obj - member FieldType: ProvidedType + abstract member FieldType: ProvidedType - member IsPublic: bool + abstract member IsPublic: bool - member IsFamily: bool + abstract member IsFamily: bool - member IsFamilyAndAssembly: bool + abstract member IsFamilyAndAssembly: bool - member IsFamilyOrAssembly: bool + abstract member IsFamilyOrAssembly: bool - member IsPrivate: bool + abstract member IsPrivate: bool static member TaintedEquals: Tainted * Tainted -> bool -[] +[] type ProvidedPropertyInfo = + new: x: System.Reflection.PropertyInfo * ctxt: ProvidedTypeContext -> ProvidedPropertyInfo inherit ProvidedMemberInfo - member GetGetMethod: unit -> ProvidedMethodInfo + abstract member GetGetMethod: unit -> ProvidedMethodInfo - member GetSetMethod: unit -> ProvidedMethodInfo + abstract member GetSetMethod: unit -> ProvidedMethodInfo - member GetIndexParameters: unit -> ProvidedParameterInfo[] + abstract member GetIndexParameters: unit -> ProvidedParameterInfo[] - member CanRead: bool + abstract member CanRead: bool - member CanWrite: bool + abstract member CanWrite: bool - member PropertyType: ProvidedType + abstract member PropertyType: ProvidedType static member TaintedGetHashCode: Tainted -> int static member TaintedEquals: Tainted * Tainted -> bool -[] +[] type ProvidedEventInfo = + new: x: System.Reflection.EventInfo * ctxt: ProvidedTypeContext -> ProvidedEventInfo inherit ProvidedMemberInfo - member GetAddMethod: unit -> ProvidedMethodInfo + abstract member GetAddMethod: unit -> ProvidedMethodInfo - member GetRemoveMethod: unit -> ProvidedMethodInfo + abstract member GetRemoveMethod: unit -> ProvidedMethodInfo - member EventHandlerType: ProvidedType + abstract member EventHandlerType: ProvidedType static member TaintedGetHashCode: Tainted -> int static member TaintedEquals: Tainted * Tainted -> bool -[] +[] type ProvidedConstructorInfo = + new: x: System.Reflection.ConstructorInfo * ctxt: ProvidedTypeContext -> ProvidedConstructorInfo inherit ProvidedMethodBase type ProvidedExprType = @@ -416,24 +453,28 @@ type ProvidedExprType = | ProvidedVarExpr of ProvidedVar -[] +[] type ProvidedExpr = + new: x: Quotations.Expr * ctxt: ProvidedTypeContext -> ProvidedExpr - member Type: ProvidedType + abstract member Type: ProvidedType /// Convert the expression to a string for diagnostics - member UnderlyingExpressionString: string + abstract member UnderlyingExpressionString: string + + abstract member GetExprType: unit -> ProvidedExprType option - member GetExprType: unit -> ProvidedExprType option + member Handle: Quotations.Expr -[] +[] type ProvidedVar = + new: x: Quotations.Var * ctxt: ProvidedTypeContext -> ProvidedVar - member Type: ProvidedType + abstract member Type: ProvidedType - member Name: string + abstract member Name: string - member IsMutable: bool + abstract member IsMutable: bool override Equals: obj -> bool @@ -442,6 +483,9 @@ type ProvidedVar = /// Get the provided expression for a particular use of a method. val GetInvokerExpression: ITypeProvider * ProvidedMethodBase * ProvidedVar[] -> ProvidedExpr +/// Get all provided types from provided namespace +val GetProvidedTypes: pn: IProvidedNamespace -> ProvidedType [] + /// Validate that the given provided type meets some of the rules for F# provided types val ValidateProvidedTypeAfterStaticInstantiation: m: range * st: Tainted * expectedPath: string[] * expectedName: string -> unit @@ -501,4 +545,37 @@ type ProvidedAssemblyStaticLinkingMap = /// We check by seeing if the type is absent from the remapping context. val IsGeneratedTypeDirectReference: Tainted * range -> bool +[] +module Shim = + + type IExtensionTypingProvider = + + /// Find and instantiate the set of ITypeProvider components for the given assembly reference + abstract InstantiateTypeProvidersOfAssembly: + runtimeAssemblyFilename: string * + designerAssemblyName: string * + ResolutionEnvironment * + bool * + isInteractive: bool * + systemRuntimeContainsType: (string -> bool) * + systemRuntimeAssemblyVersion: System.Version * + compilerToolsPath: string list * + logError: (TypeProviderError -> unit) * + m: range -> + ITypeProvider list + + abstract GetProvidedTypes: pn: IProvidedNamespace -> ProvidedType [] + abstract ResolveTypeName: pn: IProvidedNamespace * typeName: string -> ProvidedType + abstract GetInvokerExpression: + provider: ITypeProvider * methodBase: ProvidedMethodBase * paramExprs: ProvidedVar [] -> ProvidedExpr + abstract DisplayNameOfTypeProvider: typeProvider: ITypeProvider * fullName: bool -> string + + [] + type DefaultExtensionTypingProvider = + interface IExtensionTypingProvider + + [] + type ExtensionTyping = + static member Provider: IExtensionTypingProvider with get, set + #endif diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 702f7292429..bf5069ddf89 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -6017,7 +6017,7 @@ and remapTyconRepr ctxt tmenv repr = ProvidedType = info.ProvidedType.PApplyNoFailure (fun st -> let ctxt = st.Context.RemapTyconRefs(unbox >> remapTyconRef tmenv.tyconRefRemap >> box) - ProvidedType.ApplyContext (st, ctxt)) } + st.ApplyContext(ctxt)) } #endif | TNoRepr -> repr | TAsmRepr _ -> repr diff --git a/src/Compiler/TypedTree/tainted.fs b/src/Compiler/TypedTree/tainted.fs index 0eb274fa48b..642c9f76cf7 100644 --- a/src/Compiler/TypedTree/tainted.fs +++ b/src/Compiler/TypedTree/tainted.fs @@ -18,7 +18,7 @@ type internal TypeProviderToken() = interface LockToken type internal TypeProviderLock() = inherit Lock() -type internal TypeProviderError +type TypeProviderError ( errNum: int, tpDesignation: string, @@ -77,10 +77,10 @@ type internal TypeProviderError for msg in errors do f (TypeProviderError(errNum, tpDesignation, m, [msg], typeNameContext, methodNameContext)) -type TaintedContext = { TypeProvider: ITypeProvider; TypeProviderAssemblyRef: ILScopeRef; Lock: TypeProviderLock } +type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef; TypeProviderDesignation: string; Lock : TypeProviderLock } [][] -type internal Tainted<'T> (context: TaintedContext, value: 'T) = +type Tainted<'T> (context : TaintedContext, value : 'T) = do match box context.TypeProvider with | null -> @@ -88,8 +88,8 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = failwith "null ITypeProvider in Tainted constructor" | _ -> () - member _.TypeProviderDesignation = - context.TypeProvider.GetType().FullName + member _.TypeProviderDesignation = + context.TypeProviderDesignation member _.TypeProviderAssemblyRef = context.TypeProviderAssemblyRef @@ -150,9 +150,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = /// Access the target object directly. Use with extreme caution. member _.AccessObjectDirectly = value - static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef) list) = - [for tp,nm in providerSpecs do - yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] + static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef * string) list) = + [for tp,nm, tpd in providerSpecs do + yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; TypeProviderDesignation = tpd; Lock=TypeProviderLock() },tp) ] member _.OfType<'U> () = match box value with @@ -162,7 +162,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = member this.Coerce<'U> (range: range) = Tainted(context, this.Protect(fun value -> box value :?> 'U) range) -module internal Tainted = +module Tainted = let (|Null|NonNull|) (p:Tainted<'T>) : Choice> when 'T : null and 'T : not struct = if p.PUntaintNoFailure isNull then Null else NonNull (p.PApplyNoFailure id) @@ -171,6 +171,9 @@ module internal Tainted = let EqTainted (t1:Tainted<'T>) (t2:Tainted<'T>) = t1.PUntaintNoFailure(fun t1 -> t1 === t2.AccessObjectDirectly) + let PhysicallyEqTainted (t1:Tainted<'T>) (t2:Tainted<'T>) = + t1.PUntaintNoFailure(fun t1 -> t1 = t2.AccessObjectDirectly) + let GetHashCodeTainted (t:Tainted<'T>) = t.PUntaintNoFailure(fun t -> hash t) #endif diff --git a/src/Compiler/TypedTree/tainted.fsi b/src/Compiler/TypedTree/tainted.fsi index ee1a6d94069..405b1dd128e 100644 --- a/src/Compiler/TypedTree/tainted.fsi +++ b/src/Compiler/TypedTree/tainted.fsi @@ -18,7 +18,7 @@ type internal TypeProviderLock = inherit Lock /// Stores and transports aggregated list of errors reported by the type provider -type internal TypeProviderError = +type TypeProviderError = inherit System.Exception /// creates new instance of TypeProviderError that represents one error @@ -44,10 +44,10 @@ type internal TypeProviderError = /// This struct wraps a value produced by a type provider to properly attribute any failures. [] -type internal Tainted<'T> = +type Tainted<'T> = /// Create an initial tainted value - static member CreateAll: (ITypeProvider * ILScopeRef) list -> Tainted list + static member CreateAll: (ITypeProvider * ILScopeRef * string) list -> Tainted list /// A type provider that produced the value member TypeProvider: Tainted @@ -98,7 +98,7 @@ type internal Tainted<'T> = member Coerce<'U> : range: range -> Tainted<'U> [] -module internal Tainted = +module Tainted = /// Test whether the tainted value is null val (|Null|NonNull|): Tainted<'T MaybeNull> -> Choice> when 'T: null and 'T: not struct @@ -109,7 +109,9 @@ module internal Tainted = /// Test whether the tainted value equals given value. Type providers are ignored (equal tainted values produced by different type providers are equal) /// Failure in call to equality operation will be blamed on type provider of first operand - val EqTainted: Tainted<'T> -> Tainted<'T> -> bool when 'T: equality and 'T: not struct + val EqTainted: Tainted<'T> -> Tainted<'T> -> bool when 'T : equality and 'T : not struct + + val PhysicallyEqTainted: Tainted<'T> -> Tainted<'T> -> bool when 'T : equality /// Compute the hash value for the tainted value val GetHashCodeTainted: Tainted<'T> -> int when 'T: equality