wip

fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj

@@ -1,4 +1,4 @@
-<Project Sdk="Microsoft.NET.Sdk">
+<Project Sdk="Microsoft.NET.Sdk">
   <Import Project="..\netfx.props" />
   <PropertyGroup>
     <TargetFrameworks>$(FcsTargetNetFxFramework);netcoreapp3.0</TargetFrameworks>
@@ -24,6 +24,9 @@
     <Compile Include="$(FSharpSourcesRoot)\..\tests\service\AssemblyReaderShim.fs">
       <Link>AssemblyReaderShim.fs</Link>
     </Compile>
+    <Compile Include="$(FSharpSourcesRoot)\..\tests\service\ExtensionTypingProviderTests.fs">
+      <Link>ExtensionTypingProviderTests.fs</Link>
+    </Compile>
     <Compile Include="$(FSharpSourcesRoot)\..\tests\service\EditorTests.fs">
       <Link>EditorTests.fs</Link>
     </Compile>

src/fsharp/CompileOps.fs

@@ -4252,7 +4252,8 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
 
             let providers = [
                 for designTimeAssemblyName in designTimeAssemblyNames do
-                    yield! ExtensionTyping.GetTypeProvidersOfAssembly(fileNameOfRuntimeAssembly,
+                    yield! Shim.ExtensionTypingProvider.InstantiateTypeProvidersOfAssembly(
+                                                                      fileNameOfRuntimeAssembly,
                                                                       ilScopeRefOfRuntimeAssembly,
                                                                       designTimeAssemblyName,
                                                                       typeProviderEnvironment,

src/fsharp/ExtensionTyping.fs

@@ -6,7 +6,7 @@ namespace FSharp.Compiler
 
 #if !NO_EXTENSIONTYPING
 
-module internal ExtensionTyping =
+module ExtensionTyping =
     open System
     open System.IO
     open System.Collections.Generic
@@ -1186,5 +1186,49 @@ module internal ExtensionTyping =
     /// We check by seeing if the type is absent from the remapping context.
     let IsGeneratedTypeDirectReference (st: Tainted<ProvidedType>, m) =
         st.PUntaint((fun st -> st.TryGetTyconRef() |> Option.isNone), m)
-
+
+    [<AutoOpen>]
+    module Shim =
+
+        type IExtensionTypingProvider =
+            abstract InstantiateTypeProvidersOfAssembly : 
+              runtimeAssemblyFilename: string 
+              * ilScopeRefOfRuntimeAssembly:ILScopeRef
+              * designerAssemblyName: string 
+              * ResolutionEnvironment 
+              * bool
+              * isInteractive: bool
+              * systemRuntimeContainsType : (string -> bool)
+              * systemRuntimeAssemblyVersion : System.Version
+              * compilerToolsPath : string list
+              * range -> Tainted<ITypeProvider> list
+
+        [<Sealed>]
+        type DefaultExtensionTypingProvider() =
+            interface IExtensionTypingProvider with
+                member this.InstantiateTypeProvidersOfAssembly
+                    (runTimeAssemblyFileName: string, 
+                     ilScopeRefOfRuntimeAssembly: ILScopeRef, 
+                     designTimeAssemblyNameString: string, 
+                     resolutionEnvironment: ResolutionEnvironment, 
+                     isInvalidationSupported: bool, 
+                     isInteractive: bool, 
+                     systemRuntimeContainsType : string -> bool, 
+                     systemRuntimeAssemblyVersion : System.Version, 
+                     compilerToolPaths: string list,
+                     m:range) =
+
+                     GetTypeProvidersOfAssembly(runTimeAssemblyFileName,
+                                                ilScopeRefOfRuntimeAssembly,
+                                                designTimeAssemblyNameString,
+                                                resolutionEnvironment,
+                                                isInvalidationSupported,
+                                                isInteractive,
+                                                systemRuntimeContainsType,
+                                                systemRuntimeAssemblyVersion,
+                                                compilerToolPaths,
+                                                m)
+
+        let mutable ExtensionTypingProvider = DefaultExtensionTypingProvider() :> IExtensionTypingProvider
+
 #endif

src/fsharp/ExtensionTyping.fsi

@@ -6,7 +6,7 @@ namespace FSharp.Compiler
 
 #if !NO_EXTENSIONTYPING
 
-module internal ExtensionTyping =
+module ExtensionTyping =
 
     open System
     open System.IO
@@ -44,19 +44,6 @@ module internal ExtensionTyping =
         temporaryFolder             : string
       }
 
-    /// Find and instantiate the set of ITypeProvider components for the given assembly reference
-    val GetTypeProvidersOfAssembly : 
-          runtimeAssemblyFilename: string 
-          * ilScopeRefOfRuntimeAssembly:ILScopeRef
-          * designerAssemblyName: string 
-          * ResolutionEnvironment 
-          * bool
-          * isInteractive: bool
-          * systemRuntimeContainsType : (string -> bool)
-          * systemRuntimeAssemblyVersion : System.Version
-          * compilerToolsPath : string list
-          * range -> Tainted<ITypeProvider> list
-
     /// Given an extension type resolver, supply a human-readable name suitable for error messages.
     val DisplayNameOfTypeProvider : Tainted<Microsoft.FSharp.Core.CompilerServices.ITypeProvider> * range -> string
 
@@ -370,5 +357,33 @@ 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<ProvidedType> * range -> bool
+    
+    [<AutoOpen>]
+    module Shim =
+        open System
+        open FSharp.Core.CompilerServices
+        open FSharp.Compiler.AbstractIL.IL
+        open FSharp.Compiler.Range
+
+        type IExtensionTypingProvider =
+
+             /// Find and instantiate the set of ITypeProvider components for the given assembly reference
+            abstract InstantiateTypeProvidersOfAssembly : 
+              runtimeAssemblyFilename: string 
+              * ilScopeRefOfRuntimeAssembly:ILScopeRef
+              * designerAssemblyName: string 
+              * ResolutionEnvironment 
+              * bool
+              * isInteractive: bool
+              * systemRuntimeContainsType : (string -> bool)
+              * systemRuntimeAssemblyVersion : System.Version
+              * compilerToolsPath : string list
+              * range -> Tainted<ITypeProvider> list
+
+        [<Sealed>]
+        type DefaultExtensionTypingProvider =
+            interface IExtensionTypingProvider
+
+        val mutable ExtensionTypingProvider: IExtensionTypingProvider
 
 #endif

src/fsharp/tainted.fs

@@ -10,7 +10,7 @@ open Microsoft.FSharp.Core.CompilerServices
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AbstractIL.Internal.Library 
 
-type internal TypeProviderError
+type TypeProviderError
     (
         errNum : int,
         tpDesignation : string,
@@ -72,7 +72,7 @@ type internal TypeProviderError
 type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef }
 
 [<NoEquality>][<NoComparison>] 
-type internal Tainted<'T> (context : TaintedContext, value : 'T) =
+type Tainted<'T> (context : TaintedContext, value : 'T) =
     do
         match box context.TypeProvider with 
         | null -> 
@@ -153,7 +153,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
 

src/fsharp/tainted.fsi

@@ -12,7 +12,7 @@ open FSharp.Compiler.Range
 open FSharp.Compiler.AbstractIL.IL
 
 /// 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
@@ -39,7 +39,7 @@ type internal TypeProviderError =
 
 /// This struct wraps a value produced by a type provider to properly attribute any failures.
 [<NoEquality; NoComparison; Class>]
-type internal Tainted<'T> =
+type Tainted<'T> =
 
     /// Create an initial tainted value
     static member CreateAll : (ITypeProvider * ILScopeRef) list -> Tainted<ITypeProvider> list
@@ -93,7 +93,7 @@ type internal Tainted<'T> =
 
 
 [<RequireQualifiedAccess>]
-module internal Tainted =
+module Tainted =
 
     /// Test whether the tainted value is null
     val (|Null|_|) : Tainted<'T> -> unit option when 'T : null

tests/service/ExtensionTypingProviderTests.fs

@@ -0,0 +1,111 @@
+#if INTERACTIVE
+#r "../../artifacts/bin/fcs/net461/FSharp.Compiler.Service.dll" // note, build FSharp.Compiler.Service.Tests.fsproj to generate this, this DLL has a public API so can be used from F# Interactive
+#r "../../artifacts/bin/fcs/net461/nunit.framework.dll"
+#load "FsUnit.fs"
+#load "Common.fs"
+#else
+module FSharp.Compiler.Service.Tests.ExtensionTypingProvider
+#endif
+
+open System
+open System.IO
+open FsUnit
+open NUnit.Framework
+open FSharp.Compiler.ExtensionTyping
+open FSharp.Compiler.Range
+open FSharp.Compiler.AbstractIL.IL
+open FSharp.Compiler.AbstractIL.Internal.Library
+open FSharp.Compiler.Service.Tests.Common
+open FSharp.Compiler
+open FSharp.Compiler.SourceCodeServices
+
+let typeProviderProjectOptions =
+          {ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/TypeProviderConsole.fsproj";
+           ProjectId = None
+           SourceFiles = [|__SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/Program.fs"|];
+           Stamp = None
+           OtherOptions =
+            [|yield "--simpleresolution";
+              yield "--noframework";
+              yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/bin/Debug/TypeProviderConsole.exe";
+              yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderConsole/bin/Debug/TypeProviderConsole.xml";
+              yield "--subsystemversion:6.00"; 
+              yield "--highentropyva+"; 
+              yield "--fullpaths";
+              yield "--flaterrors"; 
+              yield "--target:exe"; 
+              yield "--define:DEBUG"; 
+              yield "--define:TRACE";
+              yield "--debug+"; 
+              yield "--optimize-"; 
+              yield "--tailcalls-"; 
+              yield "--debug:full";
+              yield "--platform:anycpu";
+              for r in mkStandardProjectReferences () do
+                  yield "-r:" + r
+              yield "-r:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll"|];
+           ReferencedProjects =
+            [|(__SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll",
+               {ProjectFileName = __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.fsproj";
+                ProjectId = None
+                SourceFiles = [|__SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/Library1.fs"|];
+                Stamp = None
+                OtherOptions =
+                 [|yield "--simpleresolution"; 
+                   yield "--noframework";
+                   yield "--out:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/TypeProviderLibrary.dll";
+                   yield "--doc:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/bin/Debug/TypeProviderLibrary.xml";
+                   yield "--subsystemversion:6.00"; 
+                   yield "--highentropyva+"; 
+                   yield "--fullpaths";
+                   yield "--flaterrors"; 
+                   yield "--target:library"; 
+                   yield "--define:DEBUG";
+                   yield "--define:TRACE"; 
+                   yield "--debug+"; 
+                   yield "--optimize-"; 
+                   yield "--tailcalls-";
+                   yield "--debug:full"; 
+                   yield "--platform:anycpu";
+                   for r in mkStandardProjectReferences () do
+                       yield "-r:" + r
+                   yield "-r:" + __SOURCE_DIRECTORY__ + @"/data/TypeProviderLibrary/FSharp.Data.TypeProviders.dll"; 
+                  |];
+                ReferencedProjects = [||];
+                IsIncompleteTypeCheckEnvironment = false;
+                UseScriptResolutionRules = false;
+                LoadTime = System.DateTime.Now
+                UnresolvedReferences = None;
+                OriginalLoadReferences = [];
+                ExtraProjectInfo = None;})|];
+           IsIncompleteTypeCheckEnvironment = false;
+           UseScriptResolutionRules = false;
+           LoadTime = System.DateTime.Now
+           UnresolvedReferences = None;
+           OriginalLoadReferences = [];
+           ExtraProjectInfo = None;}
+
+[<Test>]
+let ``Extension typing shim gets requests`` () =
+    let mutable gotRequest = false
+    let extensionTypingProvider =
+        { new IExtensionTypingProvider with
+            member this.InstantiateTypeProvidersOfAssembly
+                    (runTimeAssemblyFileName: string, 
+                     ilScopeRefOfRuntimeAssembly: ILScopeRef, 
+                     designTimeAssemblyNameString: string, 
+                     resolutionEnvironment: ResolutionEnvironment, 
+                     isInvalidationSupported: bool, 
+                     isInteractive: bool, 
+                     systemRuntimeContainsType : string -> bool, 
+                     systemRuntimeAssemblyVersion : System.Version, 
+                     compilerToolPaths: string list,
+                     m:range) =
+                gotRequest <- true
+                []
+        }
+
+    Shim.ExtensionTypingProvider <- extensionTypingProvider
+
+    checker.ParseAndCheckProject(typeProviderProjectOptions) |> Async.RunSynchronously |> ignore
+    gotRequest |> should be True