From e2f42daf1420ee03b9223d73a603d6cc0e140270 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/fsharp/CheckDeclarations.fs | 2 +- src/fsharp/CompilerImports.fs | 3 +- src/fsharp/ExtensionTyping.fs | 591 ++++++++++++++++++++++---------- src/fsharp/ExtensionTyping.fsi | 299 +++++++++------- src/fsharp/TypedTreeOps.fs | 2 +- src/fsharp/tainted.fs | 21 +- src/fsharp/tainted.fsi | 10 +- 7 files changed, 608 insertions(+), 320 deletions(-) diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 8b47a983b8c..6f78df6c15c 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -3453,7 +3453,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/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 82b55aaff7e..797bd1693ac 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -1434,8 +1434,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse // 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 (typeProviderEnvironment, tcConfig, m, entityToInjectInto, [], path, provider, Some st) diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index c3a0e38f952..0ef3ebfa083 100644 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -19,7 +19,7 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Range -module internal ExtensionTyping = +module ExtensionTyping = type TypeProviderDesignation = TypeProviderDesignation of string @@ -126,9 +126,8 @@ module internal ExtensionTyping = // No appropriate constructor found raise (TypeProviderError(FSComp.SR.etProviderDoesNotHaveValidConstructor(), typeProviderImplementationType.FullName, m)) - let GetTypeProvidersOfAssembly - (runtimeAssemblyFilename: string, - ilScopeRefOfRuntimeAssembly: ILScopeRef, + let GetTypeProvidersOfAssemblyInternal + (runtimeAssemblyFilename: string, designTimeName: string, resolutionEnvironment: ResolutionEnvironment, isInvalidationSupported: bool, @@ -136,9 +135,10 @@ module internal ExtensionTyping = systemRuntimeContainsType: string -> bool, systemRuntimeAssemblyVersion: System.Version, compilerToolPaths: string list, + logError: TypeProviderError -> unit, m:range) = - let providerSpecs = + let providers = try let designTimeAssemblyName = try @@ -165,17 +165,15 @@ module internal ExtensionTyping = 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 @@ -217,10 +215,6 @@ module internal ExtensionTyping = 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) = if nsp<>null then // Null namespace designates the global namespace. @@ -309,18 +303,13 @@ module internal ExtensionTyping = for KeyValue (st, tcref) in d2.Force() do dict.Add(st, f tcref) dict)) - and [] + and [] ProvidedType (x: System.Type, ctxt: ProvidedTypeContext) = inherit ProvidedMemberInfo(x, ctxt) let isMeasure = lazy x.CustomAttributes |> Seq.exists (fun a -> a.Constructor.DeclaringType.FullName = typeof.FullName) - let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) - 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) @@ -329,84 +318,135 @@ module internal ExtensionTyping = // Alternatively we could use assertions to enforce this. // Suppress relocation of generated types - member _.IsSuppressRelocate = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 - member _.IsErased = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 - member _.IsGenericType = x.IsGenericType - member _.Namespace = x.Namespace - member _.FullName = x.FullName - member _.IsArray = x.IsArray - member _.Assembly: ProvidedAssembly = x.Assembly |> ProvidedAssembly.Create - member _.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt - member _.GetMethods() = x.GetMethods bindingFlags |> ProvidedMethodInfo.CreateArray ctxt - member _.GetEvents() = x.GetEvents bindingFlags |> ProvidedEventInfo.CreateArray ctxt - member _.GetEvent nm = x.GetEvent(nm, bindingFlags) |> ProvidedEventInfo.Create ctxt - member _.GetProperties() = x.GetProperties bindingFlags |> ProvidedPropertyInfo.CreateArray ctxt - member _.GetProperty nm = x.GetProperty(nm, bindingFlags) |> ProvidedPropertyInfo.Create ctxt - member _.GetConstructors() = x.GetConstructors bindingFlags |> ProvidedConstructorInfo.CreateArray ctxt - member _.GetFields() = x.GetFields bindingFlags |> ProvidedFieldInfo.CreateArray ctxt - member _.GetField nm = x.GetField(nm, bindingFlags) |> ProvidedFieldInfo.Create ctxt - member _.GetAllNestedTypes() = x.GetNestedTypes(bindingFlags ||| BindingFlags.NonPublic) |> ProvidedType.CreateArray ctxt - member _.GetNestedTypes() = x.GetNestedTypes bindingFlags |> ProvidedType.CreateArray ctxt + abstract member IsSuppressRelocate: bool + default __.IsSuppressRelocate = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.SuppressRelocate)) <> enum 0 + abstract member IsErased: bool + default __.IsErased = (x.Attributes &&& enum (int32 TypeProviderTypeAttributes.IsErased)) <> enum 0 + abstract member IsGenericType: bool + default __.IsGenericType = x.IsGenericType + abstract member Namespace: string + default __.Namespace = x.Namespace + abstract member FullName: string + default __.FullName = x.FullName + abstract member IsArray: bool + default __.IsArray = x.IsArray + abstract member Assembly: ProvidedAssembly + default __.Assembly = x.Assembly |> ProvidedAssembly.Create + abstract member GetInterfaces: unit -> ProvidedType[] + default __.GetInterfaces() = x.GetInterfaces() |> ProvidedType.CreateArray ctxt + abstract member GetMethods: unit -> ProvidedMethodInfo[] + default __.GetMethods() = x.GetMethods bindingFlags |> ProvidedMethodInfo.CreateArray ctxt + abstract member GetEvents: unit -> ProvidedEventInfo[] + default __.GetEvents() = x.GetEvents bindingFlags |> ProvidedEventInfo.CreateArray ctxt + abstract member GetEvent: nm: string -> ProvidedEventInfo + default __.GetEvent nm = x.GetEvent(nm, bindingFlags) |> ProvidedEventInfo.Create ctxt + abstract member GetProperties: unit -> ProvidedPropertyInfo[] + default __.GetProperties() = x.GetProperties bindingFlags |> ProvidedPropertyInfo.CreateArray ctxt + abstract member GetProperty: string -> ProvidedPropertyInfo + default __.GetProperty nm = x.GetProperty(nm, bindingFlags) |> ProvidedPropertyInfo.Create ctxt + abstract member GetConstructors: unit -> ProvidedConstructorInfo[] + default __.GetConstructors() = x.GetConstructors bindingFlags |> ProvidedConstructorInfo.CreateArray ctxt + abstract GetFields: unit -> ProvidedFieldInfo[] + default __.GetFields() = x.GetFields bindingFlags |> ProvidedFieldInfo.CreateArray ctxt + abstract GetField: nm: string -> ProvidedFieldInfo + default __.GetField nm = x.GetField(nm, bindingFlags) |> ProvidedFieldInfo.Create ctxt + abstract member GetAllNestedTypes: unit -> ProvidedType[] + default __.GetAllNestedTypes() = x.GetNestedTypes(bindingFlags ||| BindingFlags.NonPublic) |> 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 - member _.GetStaticParameters(provider: ITypeProvider) = provider.GetStaticParameters x |> ProvidedParameterInfo.CreateArray ctxt + abstract member BaseType: ProvidedType + default __.BaseType = x.BaseType |> ProvidedType.Create 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 - member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt - member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = + abstract member GetElementType: unit -> ProvidedType + default __.GetElementType() = x.GetElementType() |> ProvidedType.Create ctxt + abstract member GetGenericArguments: unit -> ProvidedType[] + default __.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt + abstract member ApplyStaticArguments: ITypeProvider * string[] * obj[] -> ProvidedType + default __.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) = provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt - member _.IsVoid = (typeof.Equals x || (x.Namespace = "System" && x.Name = "Void")) - member _.IsGenericParameter = x.IsGenericParameter - member _.IsValueType = x.IsValueType - member _.IsByRef = x.IsByRef - member _.IsPointer = x.IsPointer - member _.IsPublic = x.IsPublic - member _.IsNestedPublic = x.IsNestedPublic - member _.IsEnum = x.IsEnum - member _.IsClass = x.IsClass - member _.IsMeasure = isMeasure.Value - member _.IsSealed = x.IsSealed - member _.IsAbstract = x.IsAbstract - member _.IsInterface = x.IsInterface - member _.GetArrayRank() = x.GetArrayRank() - member _.GenericParameterPosition = x.GenericParameterPosition - member _.RawSystemType = x + abstract member IsVoid: bool + default __.IsVoid = (typeof.Equals x || (x.Namespace = "System" && x.Name = "Void")) + abstract member IsGenericParameter: bool + default __.IsGenericParameter = x.IsGenericParameter + abstract member IsValueType: bool + default __.IsValueType = x.IsValueType + abstract member IsByRef: bool + default __.IsByRef = x.IsByRef + abstract member IsPointer: bool + default __.IsPointer = x.IsPointer + abstract member IsPublic: bool + default __.IsPublic = x.IsPublic + abstract member IsNestedPublic: bool + default __.IsNestedPublic = x.IsNestedPublic + abstract member IsEnum: bool + default __.IsEnum = x.IsEnum + abstract member IsClass: bool + default __.IsClass = x.IsClass + abstract member IsMeasure: bool + default __.IsMeasure = isMeasure.Value + abstract member IsSealed: bool + default __.IsSealed = x.IsSealed + abstract member IsAbstract: bool + default __.IsAbstract = x.IsAbstract + abstract member IsInterface: bool + default __.IsInterface = x.IsInterface + abstract member GetArrayRank: unit -> int + default __.GetArrayRank() = x.GetArrayRank() + 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()) - member _.MakeByRefType() = ProvidedType.CreateNoContext(x.MakeByRefType()) - member _.MakeArrayType() = ProvidedType.CreateNoContext(x.MakeArrayType()) - member _.MakeArrayType rank = ProvidedType.CreateNoContext(x.MakeArrayType(rank)) - member _.MakeGenericType (args: ProvidedType[]) = + |> ProvidedType.CreateWithNullCheck ctxt "EnumUnderlyingType" + abstract member MakePointerType: unit -> ProvidedType + default __.MakePointerType() = ProvidedType.CreateNoContext(x.MakePointerType()) + abstract member MakeByRefType: unit -> ProvidedType + default __.MakeByRefType() = ProvidedType.CreateNoContext(x.MakeByRefType()) + abstract member MakeArrayType: unit -> ProvidedType + default __.MakeArrayType() = ProvidedType.CreateNoContext(x.MakeArrayType()) + abstract member MakeArrayType: rank: int -> ProvidedType + default __.MakeArrayType rank = ProvidedType.CreateNoContext(x.MakeArrayType(rank)) + 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 (Quotations.Var(name, x)) static member Create ctxt x = match x with null -> null | t -> ProvidedType (t, ctxt) static member CreateWithNullCheck ctxt name x = match x with null -> nullArg name | t -> ProvidedType (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedType.Create ctxt) static member CreateNoContext (x: Type) = ProvidedType.Create ProvidedTypeContext.Empty x static member Void = ProvidedType.CreateNoContext typeof - member _.Handle = x - override _.Equals y = assert false; match y with :? ProvidedType as y -> x.Equals y.Handle | _ -> false - override _.GetHashCode() = assert false; x.GetHashCode() - member _.Context = ctxt + member __.Handle = x + override __.Equals y = assert false; match y with :? ProvidedType as y -> x.Equals y.Handle | _ -> false + override __.GetHashCode() = assert false; x.GetHashCode() + 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) - static member TaintedEquals (pt1: Tainted, pt2: Tainted) = - Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle)) + abstract member AsProvidedVar: nm: string -> ProvidedVar + default __.AsProvidedVar (nm) = ProvidedVar.Create ctxt (Quotations.Var(nm, x)) + abstract member ApplyContext: ProvidedTypeContext -> ProvidedType + default pt.ApplyContext (ctxt) = ProvidedType(pt.Handle, ctxt) + 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))) and [] IProvidedCustomAttributeProvider = - abstract GetDefinitionLocationAttribute: provider: ITypeProvider -> (string * int * int) option - abstract GetXmlDocAttributes: provider: ITypeProvider -> string[] - abstract GetHasTypeProviderEditorHideMethodsAttribute: provider: ITypeProvider -> bool + abstract GetCustomAttributes : provider: ITypeProvider -> seq + abstract GetDefinitionLocationAttribute : provider: ITypeProvider -> (string * int * int) option + abstract GetXmlDocAttributes : provider: ITypeProvider -> string[] + abstract GetHasTypeProviderEditorHideMethodsAttribute : provider: ITypeProvider -> bool abstract GetAttributeConstructorArgs: provider: ITypeProvider * attribName: string -> (obj option list * (string * obj option) list) option and ProvidedCustomAttributeProvider = @@ -415,8 +455,9 @@ module internal ExtensionTyping = let (|Arg|_|) (x: CustomAttributeTypedArgument) = match x.Value with null -> None | v -> Some v let findAttribByName tyFullName (a: CustomAttributeData) = (a.Constructor.DeclaringType.FullName = tyFullName) let findAttrib (ty: System.Type) a = findAttribByName ty.FullName a - { new IProvidedCustomAttributeProvider with - member _.GetAttributeConstructorArgs (provider, attribName) = + { new IProvidedCustomAttributeProvider with + member __.GetCustomAttributes provider = attributes provider + member __.GetAttributeConstructorArgs (provider, attribName) = attributes provider |> Seq.tryFind (findAttribByName attribName) |> Option.map (fun a -> @@ -456,71 +497,120 @@ module internal ExtensionTyping = and [] ProvidedMemberInfo (x: System.Reflection.MemberInfo, ctxt) = let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) - 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 - interface IProvidedCustomAttributeProvider with - member _.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider - member _.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider - member _.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider - member _.GetAttributeConstructorArgs (provider, attribName) = provide().GetAttributeConstructorArgs (provider, attribName) - - and [] + 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 this.GetCustomAttributes provider = this.GetCustomAttributes provider + member this.GetHasTypeProviderEditorHideMethodsAttribute provider = this.GetHasTypeProviderEditorHideMethodsAttribute provider + member this.GetDefinitionLocationAttribute provider = this.GetDefinitionLocationAttribute provider + member this.GetXmlDocAttributes provider = this.GetXmlDocAttributes provider + member this.GetAttributeConstructorArgs (provider, attribName) = this.GetAttributeConstructorArgs (provider, attribName) + + and [] ProvidedParameterInfo (x: System.Reflection.ParameterInfo, ctxt) = let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) - member _.Name = x.Name - member _.IsOut = x.IsOut - member _.IsIn = x.IsIn - member _.IsOptional = x.IsOptional - member _.RawDefaultValue = x.RawDefaultValue - member _.HasDefaultValue = x.Attributes.HasFlag(System.Reflection.ParameterAttributes.HasDefault) + abstract member Name: string + default __.Name = x.Name + abstract member IsOut: bool + default __.IsOut = x.IsOut + abstract member IsIn: bool + default __.IsIn = x.IsIn + abstract member IsOptional: bool + default __.IsOptional = x.IsOptional + abstract member RawDefaultValue: obj + default __.RawDefaultValue = x.RawDefaultValue + abstract member HasDefaultValue: bool + default __.HasDefaultValue = x.Attributes.HasFlag(System.Reflection.ParameterAttributes.HasDefault) /// ParameterInfo.ParameterType cannot be null - member _.ParameterType = ProvidedType.CreateWithNullCheck ctxt "ParameterType" x.ParameterType + abstract member ParameterType: ProvidedType + member __.Handle = x + 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? - interface IProvidedCustomAttributeProvider with - member _.GetHasTypeProviderEditorHideMethodsAttribute provider = provide().GetHasTypeProviderEditorHideMethodsAttribute provider - member _.GetDefinitionLocationAttribute provider = provide().GetDefinitionLocationAttribute provider - member _.GetXmlDocAttributes provider = provide().GetXmlDocAttributes provider - member _.GetAttributeConstructorArgs (provider, attribName) = provide().GetAttributeConstructorArgs (provider, attribName) - member _.Handle = x - override _.Equals y = assert false; match y with :? ProvidedParameterInfo as y -> x.Equals y.Handle | _ -> false - override _.GetHashCode() = assert false; x.GetHashCode() + 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 this.GetCustomAttributes provider = this.GetCustomAttributes provider + member this.GetHasTypeProviderEditorHideMethodsAttribute provider = this.GetHasTypeProviderEditorHideMethodsAttribute provider + member this.GetDefinitionLocationAttribute provider = this.GetDefinitionLocationAttribute provider + member this.GetXmlDocAttributes provider = this.GetXmlDocAttributes provider + member this.GetAttributeConstructorArgs (provider, attribName) = this.GetAttributeConstructorArgs (provider, attribName) - and [] - ProvidedAssembly (x: System.Reflection.Assembly) = - member _.GetName() = x.GetName() - member _.FullName = x.FullName - member _.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x - static member Create (x: System.Reflection.Assembly) = match x with null -> null | t -> ProvidedAssembly (t) - member _.Handle = x - override _.Equals y = assert false; match y with :? ProvidedAssembly as y -> x.Equals y.Handle | _ -> false - override _.GetHashCode() = assert false; x.GetHashCode() + override __.Equals y = assert false; match y with :? ProvidedParameterInfo as y -> x.Equals y.Handle | _ -> false + override __.GetHashCode() = assert false; x.GetHashCode() + + and [] + ProvidedAssembly (x: System.Reflection.Assembly) = + abstract member GetName : unit -> System.Reflection.AssemblyName + default __.GetName() = x.GetName() + abstract member FullName : string + default __.FullName = x.FullName + abstract member GetManifestModuleContents : ITypeProvider -> byte[] + default __.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents x + static member Create x = match x with null -> null | t -> ProvidedAssembly (t) + member __.Handle = x + override __.Equals y = assert false; match y with :? ProvidedAssembly as y -> x.Equals y.Handle | _ -> false + override __.GetHashCode() = assert false; x.GetHashCode() and [] ProvidedMethodBase (x: System.Reflection.MethodBase, ctxt) = inherit ProvidedMemberInfo(x, ctxt) - member _.Context = ctxt - member _.IsGenericMethod = x.IsGenericMethod - member _.IsStatic = x.IsStatic - member _.IsFamily = x.IsFamily - member _.IsFamilyOrAssembly = x.IsFamilyOrAssembly - member _.IsFamilyAndAssembly = x.IsFamilyAndAssembly - member _.IsVirtual = x.IsVirtual - member _.IsFinal = x.IsFinal - member _.IsPublic = x.IsPublic - member _.IsAbstract = x.IsAbstract - member _.IsHideBySig = x.IsHideBySig - member _.IsConstructor = x.IsConstructor - member _.GetParameters() = x.GetParameters() |> ProvidedParameterInfo.CreateArray ctxt - member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt - member _.Handle = x + member __.Context = ctxt + abstract member IsGenericMethod: bool + default __.IsGenericMethod = x.IsGenericMethod + abstract member IsStatic: bool + default __.IsStatic = x.IsStatic + abstract member IsFamily: bool + default __.IsFamily = x.IsFamily + abstract member IsFamilyOrAssembly: bool + default __.IsFamilyOrAssembly = x.IsFamilyOrAssembly + abstract member IsFamilyAndAssembly: bool + default __.IsFamilyAndAssembly = x.IsFamilyAndAssembly + abstract member IsVirtual: bool + default __.IsVirtual = x.IsVirtual + abstract member IsFinal: bool + default __.IsFinal = x.IsFinal + abstract member IsPublic: bool + default __.IsPublic = x.IsPublic + abstract member IsAbstract: bool + default __.IsAbstract = x.IsAbstract + abstract member IsHideBySig: bool + default __.IsHideBySig = x.IsHideBySig + abstract member IsConstructor: bool + default __.IsConstructor = x.IsConstructor + abstract member GetParameters: unit -> ProvidedParameterInfo[] + default __.GetParameters() = x.GetParameters() |> ProvidedParameterInfo.CreateArray ctxt + abstract member GetGenericArguments: unit -> ProvidedType[] + default __.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt + member __.Handle = x static member TaintedGetHashCode (x: Tainted) = 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 = @@ -541,7 +631,9 @@ module internal ExtensionTyping = 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 = @@ -571,55 +663,74 @@ module internal ExtensionTyping = | _ -> failwith (FSComp.SR.estApplyStaticArgumentsForMethodNotImplemented()) - and [] + and [] ProvidedFieldInfo (x: System.Reflection.FieldInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) static member Create ctxt x = match x with null -> null | t -> ProvidedFieldInfo (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedFieldInfo.Create ctxt) - member _.IsInitOnly = x.IsInitOnly - member _.IsStatic = x.IsStatic - member _.IsSpecialName = x.IsSpecialName - member _.IsLiteral = x.IsLiteral - member _.GetRawConstantValue() = x.GetRawConstantValue() + abstract member IsInitOnly: bool + default __.IsInitOnly = x.IsInitOnly + abstract member IsStatic: bool + default __.IsStatic = x.IsStatic + abstract member IsSpecialName: bool + default __.IsSpecialName = x.IsSpecialName + abstract member IsLiteral: bool + default __.IsLiteral = x.IsLiteral + abstract member GetRawConstantValue: unit -> obj + default __.GetRawConstantValue() = x.GetRawConstantValue() /// FieldInfo.FieldType cannot be null - member _.FieldType = x.FieldType |> ProvidedType.CreateWithNullCheck ctxt "FieldType" - member _.Handle = x - member _.IsPublic = x.IsPublic - member _.IsFamily = x.IsFamily - member _.IsPrivate = x.IsPrivate - member _.IsFamilyOrAssembly = x.IsFamilyOrAssembly - member _.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() + abstract member FieldType: ProvidedType + default __.FieldType = x.FieldType |> ProvidedType.CreateWithNullCheck ctxt "FieldType" + member __.Handle = x + abstract member IsPublic: bool + default __.IsPublic = x.IsPublic + abstract member IsFamily: bool + default __.IsFamily = x.IsFamily + abstract member IsPrivate: bool + default __.IsPrivate = x.IsPrivate + abstract member IsFamilyOrAssembly: bool + default __.IsFamilyOrAssembly = x.IsFamilyOrAssembly + 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))) - and [] + and [] ProvidedMethodInfo (x: System.Reflection.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) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedMethodInfo.Create ctxt) - member _.Handle = x - member _.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() + member __.Handle = x + 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() - and [] + and [] ProvidedPropertyInfo (x: System.Reflection.PropertyInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) - member _.GetGetMethod() = x.GetGetMethod() |> ProvidedMethodInfo.Create ctxt - member _.GetSetMethod() = x.GetSetMethod() |> ProvidedMethodInfo.Create ctxt - member _.CanRead = x.CanRead - member _.CanWrite = x.CanWrite - member _.GetIndexParameters() = x.GetIndexParameters() |> ProvidedParameterInfo.CreateArray ctxt + abstract member GetGetMethod: unit -> ProvidedMethodInfo + default __.GetGetMethod() = x.GetGetMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetSetMethod: unit -> ProvidedMethodInfo + default __.GetSetMethod() = x.GetSetMethod() |> ProvidedMethodInfo.Create ctxt + abstract member CanRead: bool + default __.CanRead = x.CanRead + abstract member CanWrite: bool + default __.CanWrite = x.CanWrite + 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) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedPropertyInfo.Create ctxt) member _.Handle = x @@ -628,15 +739,18 @@ module internal ExtensionTyping = static member TaintedGetHashCode (x: Tainted) = 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))) - and [] + and [] ProvidedEventInfo (x: System.Reflection.EventInfo, ctxt) = inherit ProvidedMemberInfo(x, ctxt) - member _.GetAddMethod() = x.GetAddMethod() |> ProvidedMethodInfo.Create ctxt - member _.GetRemoveMethod() = x.GetRemoveMethod() |> ProvidedMethodInfo.Create ctxt + abstract member GetAddMethod: unit -> ProvidedMethodInfo + default __.GetAddMethod() = x.GetAddMethod() |> 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) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedEventInfo.Create ctxt) member _.Handle = x @@ -645,9 +759,9 @@ module internal ExtensionTyping = static member TaintedGetHashCode (x: Tainted) = 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))) - and [] + and [] ProvidedConstructorInfo (x: System.Reflection.ConstructorInfo, ctxt) = inherit ProvidedMethodBase(x, ctxt) static member Create ctxt x = match x with null -> null | t -> ProvidedConstructorInfo (t, ctxt) @@ -681,13 +795,15 @@ module internal ExtensionTyping = | ProvidedIfThenElseExpr of ProvidedExpr * ProvidedExpr * ProvidedExpr | ProvidedVarExpr of ProvidedVar - and [] + and [] ProvidedExpr (x: Quotations.Expr, ctxt) = - member _.Type = x.Type |> ProvidedType.Create ctxt - member _.Handle = x - member _.Context = ctxt - member _.UnderlyingExpressionString = x.ToString() - member _.GetExprType() = + abstract member Type: ProvidedType + default __.Type = x.Type |> ProvidedType.Create ctxt + member __.Context = ctxt + abstract member UnderlyingExpressionString: string + default __.UnderlyingExpressionString = x.ToString() + abstract member GetExprType: unit -> ProvidedExprType option + default __.GetExprType() = match x with | Quotations.Patterns.NewObject(ctor, args) -> Some (ProvidedNewObjectExpr (ProvidedConstructorInfo.Create ctxt ctor, [| for a in args -> ProvidedExpr.Create ctxt a |])) @@ -734,26 +850,135 @@ module internal ExtensionTyping = | Quotations.Patterns.Var v -> Some (ProvidedVarExpr (ProvidedVar.Create ctxt v)) | _ -> None + member __.Handle = x static member Create ctxt t = match box t with null -> null | _ -> ProvidedExpr (t, ctxt) static member CreateArray ctxt xs = match xs with null -> null | _ -> xs |> Array.map (ProvidedExpr.Create ctxt) override _.Equals y = match y with :? ProvidedExpr as y -> x.Equals y.Handle | _ -> false override _.GetHashCode() = x.GetHashCode() - and [] + and [] ProvidedVar (x: Quotations.Var, ctxt) = - member _.Type = x.Type |> ProvidedType.Create ctxt - member _.Name = x.Name - member _.IsMutable = x.IsMutable - member _.Handle = x - member _.Context = ctxt + 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 __.Context = ctxt + member __.Handle = x 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 + + let mutable ExtensionTypingProvider = DefaultExtensionTypingProvider() :> IExtensionTypingProvider + + let shimLogger (tpe: TypeProviderError) = + tpe.Iter(fun e -> errorR(Error((e.Number, e.ContextualErrorMessage), e.Range))) + + + let GetTypeProvidersOfAssembly + (runTimeAssemblyFileName: string, + ilScopeRefOfRuntimeAssembly: ILScopeRef, + designTimeAssemblyNameString: string, + resolutionEnvironment: ResolutionEnvironment, + isInvalidationSupported: bool, + isInteractive: bool, + systemRuntimeContainsType : string -> bool, + systemRuntimeAssemblyVersion : System.Version, + compilerToolPaths: string list, + m: range) = + + let providers = ExtensionTypingProvider.InstantiateTypeProvidersOfAssembly( + runTimeAssemblyFileName, + designTimeAssemblyNameString, + resolutionEnvironment, + isInvalidationSupported, + isInteractive, + systemRuntimeContainsType, + systemRuntimeAssemblyVersion, + compilerToolPaths, + Shim.shimLogger, + m) + + Tainted<_>.CreateAll (providers |> List.map (fun p -> p, ilScopeRefOfRuntimeAssembly, ExtensionTypingProvider.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 -> Quotations.Expr.Var (p.Handle) |]) |> ProvidedExpr.Create methodBase.Context + ExtensionTypingProvider.GetInvokerExpression(provider, methodBase, paramExprs) + + /// Get all provided types from provided namespace + let GetProvidedTypes (pn: IProvidedNamespace) = + ExtensionTypingProvider.GetProvidedTypes(pn) + + // Get the string to show for the name of a type provider + let DisplayNameOfTypeProvider (resolver: Tainted, m: range) = + resolver.PUntaint((fun tp -> ExtensionTypingProvider.DisplayNameOfTypeProvider(tp, false)), m) /// Compute the Name or FullName property of a provided type, reporting appropriate errors let CheckAndComputeProvidedNameProperty(m, st: Tainted, proj, propertyString) = @@ -938,7 +1163,7 @@ module internal ExtensionTyping = // 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 -> ExtensionTypingProvider.ResolveTypeName(providedNamespace, typeName)), range=m) match resolvedType with | Tainted.Null -> None | result -> diff --git a/src/fsharp/ExtensionTyping.fsi b/src/fsharp/ExtensionTyping.fsi index 311d7959982..60d45ee71ab 100755 --- a/src/fsharp/ExtensionTyping.fsi +++ b/src/fsharp/ExtensionTyping.fsi @@ -8,11 +8,12 @@ namespace FSharp.Compiler open System open System.Collections.Generic +open System.Reflection open FSharp.Core.CompilerServices open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.Text -module internal ExtensionTyping = +module ExtensionTyping = type TypeProviderDesignation = TypeProviderDesignation of string @@ -85,161 +86,183 @@ module internal ExtensionTyping = /// Map the TyconRef objects, if any member RemapTyconRefs : (obj -> obj) -> ProvidedTypeContext - and [] + and [] ProvidedType = + new : x: System.Type * ctxt: ProvidedTypeContext -> ProvidedType inherit ProvidedMemberInfo - member IsSuppressRelocate : bool - member IsErased : bool - member IsGenericType : bool - member Namespace : string - member FullName : string - member IsArray : bool - member GetInterfaces : unit -> ProvidedType[] - member Assembly : ProvidedAssembly - member BaseType : ProvidedType - member GetNestedType : string -> ProvidedType - member GetNestedTypes : unit -> ProvidedType[] - member GetAllNestedTypes : unit -> ProvidedType[] - member GetMethods : unit -> ProvidedMethodInfo[] - member GetFields : unit -> ProvidedFieldInfo[] - member GetField : string -> ProvidedFieldInfo - member GetProperties : unit -> ProvidedPropertyInfo[] - member GetProperty : string -> ProvidedPropertyInfo - member GetEvents : unit -> ProvidedEventInfo[] - member GetEvent : string -> ProvidedEventInfo - member GetConstructors : unit -> ProvidedConstructorInfo[] - member GetStaticParameters : ITypeProvider -> ProvidedParameterInfo[] - member GetGenericTypeDefinition : unit -> ProvidedType - member IsVoid : bool - member IsGenericParameter : bool - member IsValueType : bool - member IsByRef : bool - member IsPointer : bool - member IsEnum : bool - member IsInterface : bool - member IsClass : bool - member IsMeasure: bool - member IsSealed : bool - member IsAbstract : bool - member IsPublic : bool - member IsNestedPublic : bool - member GenericParameterPosition : int - member GetElementType : unit -> ProvidedType - member GetGenericArguments : unit -> ProvidedType[] - member GetArrayRank : unit -> int + abstract member IsSuppressRelocate : bool + abstract member IsErased : bool + abstract member IsGenericType : bool + abstract member Namespace : string + abstract member FullName : string + abstract member IsArray : bool + abstract member GetInterfaces : unit -> ProvidedType[] + abstract member Assembly : ProvidedAssembly + abstract member BaseType : ProvidedType + abstract member GetNestedType : string -> ProvidedType + abstract member GetNestedTypes : unit -> ProvidedType[] + abstract member GetAllNestedTypes : unit -> ProvidedType[] + abstract member GetMethods : unit -> ProvidedMethodInfo[] + abstract member GetFields : unit -> ProvidedFieldInfo[] + abstract member GetField : string -> ProvidedFieldInfo + abstract member GetProperties : unit -> ProvidedPropertyInfo[] + abstract member GetProperty : string -> ProvidedPropertyInfo + abstract member GetEvents : unit -> ProvidedEventInfo[] + abstract member GetEvent : string -> ProvidedEventInfo + abstract member GetConstructors : unit -> ProvidedConstructorInfo[] member RawSystemType : System.Type - member GetEnumUnderlyingType : unit -> ProvidedType - member MakePointerType: unit -> ProvidedType - member MakeByRefType: unit -> ProvidedType - member MakeArrayType: unit -> ProvidedType - member MakeArrayType: rank: int -> ProvidedType - member MakeGenericType: args: ProvidedType[] -> ProvidedType - member AsProvidedVar : name: string -> ProvidedVar + abstract member GetStaticParameters : ITypeProvider -> ProvidedParameterInfo[] + abstract member ApplyStaticArguments: ITypeProvider * string[] * obj[] -> ProvidedType + abstract member GetGenericTypeDefinition : unit -> ProvidedType + abstract member IsVoid : bool + abstract member IsGenericParameter : bool + abstract member IsValueType : bool + abstract member IsByRef : bool + abstract member IsPointer : bool + abstract member IsEnum : bool + abstract member IsInterface : bool + abstract member IsClass : bool + abstract member IsMeasure: bool + abstract member IsSealed : bool + abstract member IsAbstract : bool + abstract member IsPublic : bool + abstract member IsNestedPublic : bool + abstract member GenericParameterPosition : int + abstract member GetElementType : unit -> ProvidedType + abstract member GetGenericArguments : unit -> ProvidedType[] + abstract member GetArrayRank : unit -> int + abstract member GetEnumUnderlyingType : unit -> ProvidedType + abstract member MakePointerType: unit -> ProvidedType + abstract member MakeByRefType: unit -> ProvidedType + abstract member MakeArrayType: unit -> ProvidedType + abstract member MakeArrayType: rank: int -> ProvidedType + abstract member MakeGenericType: args: ProvidedType[] -> ProvidedType + abstract member AsProvidedVar: nm: string -> ProvidedVar static member Void : ProvidedType static member CreateNoContext : Type -> ProvidedType member TryGetILTypeRef : unit -> ILTypeRef option member TryGetTyconRef : unit -> obj option - static member ApplyContext : ProvidedType * ProvidedTypeContext -> ProvidedType - member Context : ProvidedTypeContext - interface IProvidedCustomAttributeProvider + abstract member ApplyContext : ProvidedTypeContext -> ProvidedType + abstract member Context : ProvidedTypeContext static member TaintedEquals : Tainted * Tainted -> bool and [] IProvidedCustomAttributeProvider = + abstract GetCustomAttributes : provider: ITypeProvider -> seq 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 - and [] - ProvidedAssembly = - member GetName : unit -> System.Reflection.AssemblyName - member FullName : string - member GetManifestModuleContents : ITypeProvider -> byte[] + and [] + ProvidedAssembly = + new: x: System.Reflection.Assembly -> ProvidedAssembly + abstract member GetName : unit -> System.Reflection.AssemblyName + abstract member FullName : string + abstract member GetManifestModuleContents : ITypeProvider -> byte[] member Handle : System.Reflection.Assembly and [] ProvidedMemberInfo = - member Name :string - member DeclaringType : ProvidedType + abstract member Name :string + abstract member DeclaringType : ProvidedType + abstract GetCustomAttributes : provider: ITypeProvider -> seq + 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 and [] ProvidedMethodBase = inherit ProvidedMemberInfo - member IsGenericMethod : bool - member IsStatic : bool - member IsFamily : bool - member IsFamilyAndAssembly : bool - member IsFamilyOrAssembly : bool - member IsVirtual : bool - member IsFinal : bool - member IsPublic : bool - member IsAbstract : bool - member IsHideBySig : bool - member IsConstructor : bool - member GetParameters : unit -> ProvidedParameterInfo[] - member GetGenericArguments : unit -> ProvidedType[] - member GetStaticParametersForMethod : ITypeProvider -> ProvidedParameterInfo[] + member Context : ProvidedTypeContext + abstract member IsGenericMethod : bool + abstract member IsStatic : bool + abstract member IsFamily : bool + abstract member IsFamilyAndAssembly : bool + abstract member IsFamilyOrAssembly : bool + abstract member IsVirtual : bool + abstract member IsFinal : bool + abstract member IsPublic : bool + abstract member IsAbstract : bool + abstract member IsHideBySig : bool + abstract member IsConstructor : bool + abstract member GetParameters : unit -> ProvidedParameterInfo[] + abstract member GetGenericArguments : unit -> ProvidedType[] + 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 - and [] - ProvidedMethodInfo = + and [] + ProvidedMethodInfo = + new: x: System.Reflection.MethodInfo * ctxt: ProvidedTypeContext -> ProvidedMethodInfo inherit ProvidedMethodBase - member ReturnType : ProvidedType - member MetadataToken : int - - and [] - ProvidedParameterInfo = - member Name :string - member ParameterType : ProvidedType - member IsIn : bool - member IsOut : bool - member IsOptional : bool - member RawDefaultValue : obj - member HasDefaultValue : bool + member Handle: System.Reflection.MethodInfo + abstract member ReturnType : ProvidedType + abstract member MetadataToken : int + + and [] + ProvidedParameterInfo = + new: x: System.Reflection.ParameterInfo * ctxt: ProvidedTypeContext -> ProvidedParameterInfo + abstract member Name :string + abstract member ParameterType : ProvidedType + abstract member IsIn : bool + abstract member IsOut : bool + abstract member IsOptional : bool + abstract member RawDefaultValue : obj + abstract member HasDefaultValue : bool + abstract GetCustomAttributes : provider: ITypeProvider -> seq + 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 - and [] + and [] ProvidedFieldInfo = inherit ProvidedMemberInfo - member IsInitOnly : bool - member IsStatic : bool - member IsSpecialName : bool - member IsLiteral : bool - member GetRawConstantValue : unit -> obj - member FieldType : ProvidedType - member IsPublic : bool - member IsFamily : bool - member IsFamilyAndAssembly : bool - member IsFamilyOrAssembly : bool - member IsPrivate : bool + new: x: System.Reflection.FieldInfo * ctxt: ProvidedTypeContext -> ProvidedFieldInfo + abstract member IsInitOnly : bool + abstract member IsStatic : bool + abstract member IsSpecialName : bool + abstract member IsLiteral : bool + abstract member GetRawConstantValue : unit -> obj + abstract member FieldType : ProvidedType + abstract member IsPublic : bool + abstract member IsFamily : bool + abstract member IsFamilyAndAssembly : bool + abstract member IsFamilyOrAssembly : bool + abstract member IsPrivate : bool static member TaintedEquals : Tainted * Tainted -> bool - and [] - ProvidedPropertyInfo = + and [] + ProvidedPropertyInfo = + new: x: System.Reflection.PropertyInfo * ctxt: ProvidedTypeContext -> ProvidedPropertyInfo inherit ProvidedMemberInfo - member GetGetMethod : unit -> ProvidedMethodInfo - member GetSetMethod : unit -> ProvidedMethodInfo - member GetIndexParameters : unit -> ProvidedParameterInfo[] - member CanRead : bool - member CanWrite : bool - member PropertyType : ProvidedType + abstract member GetGetMethod : unit -> ProvidedMethodInfo + abstract member GetSetMethod : unit -> ProvidedMethodInfo + abstract member GetIndexParameters : unit -> ProvidedParameterInfo[] + abstract member CanRead : bool + abstract member CanWrite : bool + abstract member PropertyType : ProvidedType static member TaintedGetHashCode : Tainted -> int static member TaintedEquals : Tainted * Tainted -> bool - and [] + and [] ProvidedEventInfo = inherit ProvidedMemberInfo - member GetAddMethod : unit -> ProvidedMethodInfo - member GetRemoveMethod : unit -> ProvidedMethodInfo - member EventHandlerType : ProvidedType + new: x: System.Reflection.EventInfo * ctxt: ProvidedTypeContext -> ProvidedEventInfo + abstract member GetAddMethod : unit -> ProvidedMethodInfo + abstract member GetRemoveMethod : unit -> ProvidedMethodInfo + abstract member EventHandlerType : ProvidedType static member TaintedGetHashCode : Tainted -> int static member TaintedEquals : Tainted * Tainted -> bool - and [] - ProvidedConstructorInfo = + and [] + ProvidedConstructorInfo = + new: x: System.Reflection.ConstructorInfo * ctxt: ProvidedTypeContext -> ProvidedConstructorInfo inherit ProvidedMethodBase and ProvidedExprType = @@ -267,24 +290,31 @@ module internal ExtensionTyping = | ProvidedIfThenElseExpr of ProvidedExpr * ProvidedExpr * ProvidedExpr | ProvidedVarExpr of ProvidedVar - and [] + + and [] ProvidedExpr = - member Type : ProvidedType + new: x: Quotations.Expr * ctxt: ProvidedTypeContext -> ProvidedExpr + abstract member Type : ProvidedType /// Convert the expression to a string for diagnostics - member UnderlyingExpressionString : string - member GetExprType : unit -> ProvidedExprType option + abstract member UnderlyingExpressionString : string + abstract member GetExprType : unit -> ProvidedExprType option + member Handle: Quotations.Expr - and [] + and [] ProvidedVar = - member Type : ProvidedType - member Name : string - member IsMutable : bool + new: x: Quotations.Var * ctxt: ProvidedTypeContext -> ProvidedVar + abstract member Type : ProvidedType + abstract member Name : string + abstract member IsMutable : bool override Equals : obj -> bool override GetHashCode : unit -> int /// 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 : range * Tainted * expectedPath : string[] * expectedName : string-> unit @@ -336,5 +366,34 @@ module internal ExtensionTyping = /// Check if this is a direct reference to a non-embedded generated type. This is not permitted at any name resolution. /// 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 + + val mutable ExtensionTypingProvider: IExtensionTypingProvider #endif diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 9fd50c3f059..fc8949e8faf 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -5486,7 +5486,7 @@ and remapTyconRepr g 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/fsharp/tainted.fs b/src/fsharp/tainted.fs index 32bf469600e..238d7d3b4cb 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/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 (new 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 @@ -148,9 +148,9 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = /// Access the target object directly. Use with extreme caution. member this.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 this.OfType<'U> () = match box value with @@ -160,7 +160,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|_|) (p:Tainted<'T>) = if p.PUntaintNoFailure(fun p -> match p with null -> true | _ -> false) then Some() else None @@ -169,6 +169,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/fsharp/tainted.fsi b/src/fsharp/tainted.fsi index 06127f5a622..ac526235109 100644 --- a/src/fsharp/tainted.fsi +++ b/src/fsharp/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 @@ -45,10 +45,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|_|) : Tainted<'T> -> unit option when 'T : null @@ -110,6 +110,8 @@ 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 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