CompilerTools switch initial implementation

Author: KevinRansom

src/fsharp/CompileOps.fs

@@ -2029,6 +2029,7 @@ type TcConfigBuilder =
       mutable light: bool option
       mutable conditionalCompilationDefines: string list
       mutable loadedSources: (range * string) list
+      mutable compilerToolPaths: string list
       mutable referencedDLLs: AssemblyReference list
       mutable projectReferences: IProjectReference list
       mutable knownUnresolvedReferences: UnresolvedAssemblyReference list
@@ -2193,6 +2194,7 @@ type TcConfigBuilder =
           resolutionEnvironment = ResolutionEnvironment.EditingOrCompilation false
           framework = true
           implicitlyResolveAssemblies = true
+          compilerToolPaths = []
           referencedDLLs = []
           projectReferences = []
           knownUnresolvedReferences = []
@@ -2424,6 +2426,13 @@ type TcConfigBuilder =
     member tcConfigB.AddEmbeddedResource filename =
         tcConfigB.embedResources <- tcConfigB.embedResources ++ filename
 
+    member tcConfigB.AddCompilerToolsByPath (m:range, path) = 
+        if FileSystem.IsInvalidPathShim(path) then
+            warning(Error(FSComp.SR.buildInvalidAssemblyName(path), m))
+        elif not (tcConfigB.compilerToolPaths  |> List.exists (fun text -> path = text)) then // NOTE: We keep same paths if range is different.
+            let compilerToolPath = tcConfigB.compilerToolPaths |> List.tryPick (fun text -> if text = path then Some text else None)
+            tcConfigB.compilerToolPaths <- tcConfigB.compilerToolPaths ++ (Option.defaultValue "" compilerToolPath)   //AssemblyReference(m, path, projectReference)             
+
     member tcConfigB.AddReferencedAssemblyByPath (m, path) = 
         if FileSystem.IsInvalidPathShim path then
             warning(Error(FSComp.SR.buildInvalidAssemblyName(path), m))
@@ -2682,6 +2691,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member x.light = data.light
     member x.conditionalCompilationDefines = data.conditionalCompilationDefines
     member x.loadedSources = data.loadedSources
+    member x.compilerToolPaths = data.compilerToolPaths
     member x.referencedDLLs = data.referencedDLLs
     member x.knownUnresolvedReferences = data.knownUnresolvedReferences
     member x.clrRoot = clrRootValue
@@ -4261,7 +4271,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
             let providers = 
                 [ for designTimeAssemblyName in designTimeAssemblyNames do
                       yield! ExtensionTyping.GetTypeProvidersOfAssembly(fileNameOfRuntimeAssembly, ilScopeRefOfRuntimeAssembly, designTimeAssemblyName, typeProviderEnvironment, 
-                                                                        tcConfig.isInvalidationSupported, tcConfig.isInteractive, systemRuntimeContainsType, primaryAssemblyVersion, m) ]
+                                                                        tcConfig.isInvalidationSupported, tcConfig.isInteractive, systemRuntimeContainsType, primaryAssemblyVersion, tcConfig.compilerToolPaths, m) ]
 
             // Note, type providers are disposable objects. The TcImports owns the provider objects - when/if it is disposed, the providers are disposed.
             // We ignore all exceptions from provider disposal.
@@ -4545,7 +4555,6 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
     member tcImports.RegisterAndImportReferencedAssemblies (ctok, nms: AssemblyResolution list) =
       cancellable {
         CheckDisposed()
-
         let! results = 
            nms |> Cancellable.each (fun nm -> 
                cancellable {

src/fsharp/CompileOps.fsi

@@ -272,7 +272,7 @@ type TcConfigBuilder =
       mutable conditionalCompilationDefines: string list
       /// Sources added into the build with #load
       mutable loadedSources: (range * string) list
-      
+      mutable compilerToolPaths: string  list
       mutable referencedDLLs: AssemblyReference  list
       mutable projectReferences: IProjectReference list
       mutable knownUnresolvedReferences: UnresolvedAssemblyReference list
@@ -408,6 +408,7 @@ type TcConfigBuilder =
     member TurnWarningOff: range * string -> unit
     member TurnWarningOn: range * string -> unit
     member AddIncludePath: range * string * string -> unit
+    member AddCompilerToolsByPath: range * string -> unit
     member AddReferencedAssemblyByPath: range * string -> unit
     member RemoveReferencedAssemblyByPath: range * string -> unit
     member AddEmbeddedSourceFile: string -> unit
@@ -441,6 +442,7 @@ type TcConfig =
     member conditionalCompilationDefines: string list
     member subsystemVersion: int * int
     member useHighEntropyVA: bool
+    member compilerToolPaths: string list
     member referencedDLLs: AssemblyReference list
     member reduceMemoryUsage: ReduceMemoryFlag
     member inputCodePage: int option

src/fsharp/CompileOptions.fs

@@ -559,11 +559,18 @@ let PrintOptionInfo (tcConfigB:TcConfigBuilder) =
 // OptionBlock: Input files
 //-------------------------
 
-let inputFileFlagsBoth (tcConfigB: TcConfigBuilder) =
+let inputFileFlagsBoth (tcConfigB : TcConfigBuilder) = [
     [ CompilerOption("reference", tagFile, OptionString (fun s -> tcConfigB.AddReferencedAssemblyByPath (rangeStartup, s)), None, Some (FSComp.SR.optsReference()))
-    ]
+      CompilerOption("compilertool", tagFile, OptionString (fun s -> tcConfigB.AddCompilerToolsByPath (rangeStartup, s)), None, Some (FSComp.SR.optsCompilerTool()))
+
+let referenceFlagAbbrev (tcConfigB : TcConfigBuilder) =
+    CompilerOption("r", tagFile, OptionString (fun s -> tcConfigB.AddReferencedAssemblyByPath (rangeStartup, s)), None, Some(FSComp.SR.optsShortFormOf("--reference")))
+
+let compilerToolFlagAbbrev (tcConfigB : TcConfigBuilder) =
+    CompilerOption("t", tagFile, OptionString (fun s -> tcConfigB.AddCompilerToolsByPath (rangeStartup, s)), None, Some(FSComp.SR.optsShortFormOf("--compilertool")))
 
-let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB 
+let inputFileFlagsFsi tcConfigB = inputFileFlagsBoth tcConfigB
+let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB
 
 let inputFileFlagsFsiBase (_tcConfigB: TcConfigBuilder) =
 #if NETSTANDARD

src/fsharp/CompileOptions.fsi

@@ -12,7 +12,7 @@ open FSharp.Compiler.TcGlobals
 
 //----------------------------------------------------------------------------
 // Compiler Option Parser
-//--------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 
 // For command-line options that can be suffixed with +/-
 [<RequireQualifiedAccess>]
@@ -89,7 +89,7 @@ val NormalizeAssemblyRefs : CompilationThreadToken * TcImports -> (AbstractIL.IL
 // Miscellany
 val ignoreFailureOnMono1_1_16 : (unit -> unit) -> unit
 val mutable enableConsoleColoring : bool
-val DoWithColor : System.ConsoleColor -> (unit -> 'a) -> 'a
+val DoWithColor : ConsoleColor -> (unit -> 'a) -> 'a
 val DoWithErrorColor : bool -> (unit -> 'a) -> 'a
 val ReportTime : TcConfig -> string -> unit
 val GetAbbrevFlagSet : TcConfigBuilder -> bool -> Set<string>

src/fsharp/ExtensionTyping.fs

@@ -62,7 +62,7 @@ module internal ExtensionTyping =
 
     /// Load a the design-time part of a type-provider into the host process, and look for types
     /// marked with the TypeProviderAttribute attribute.
-    let GetTypeProviderImplementationTypes (runTimeAssemblyFileName, designTimeAssemblyNameString, m: range) =
+    let GetTypeProviderImplementationTypes (runTimeAssemblyFileName, designTimeAssemblyNameString, m:range, compilerToolPaths:string list) =
 
         // Report an error, blaming the particular type provider component
         let raiseError (e: exn) =
@@ -102,6 +102,17 @@ module internal ExtensionTyping =
 
         let designTimeAssemblyOpt = 
 
+            // If we've found a design-time assembly, look for the public types with TypeProviderAttribute
+
+            // ===========================================================================================
+            // CompilerTools can also TypeProvider design time tools
+            // TODO:  Search xompilerToolPaths for designtime type provider
+            // ===========================================================================================
+
+            ignore (compilerToolPaths)
+
+            // ===========================================================================================
+
             if designTimeAssemblyNameString.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then
                 loadFromParentDirRelativeToRuntimeAssemblyLocation designTimeAssemblyNameString
             else
@@ -123,7 +134,6 @@ module internal ExtensionTyping =
                     with e ->
                         raiseError e
 
-        // If we've find a design-time assembly, look for the public types with TypeProviderAttribute
         match designTimeAssemblyOpt with
         | Some loadedDesignTimeAssembly ->
             try
@@ -194,7 +204,8 @@ module internal ExtensionTyping =
              isInteractive: bool, 
              systemRuntimeContainsType : string -> bool, 
              systemRuntimeAssemblyVersion : System.Version, 
-             m: range) =         
+             compilerToolPaths: string list,
+             m:range) =
 
         let providerSpecs = 
                 try
@@ -214,7 +225,7 @@ module internal ExtensionTyping =
                       | Some designTimeAssemblyName, Some path when String.Compare(designTimeAssemblyName.Name, Path.GetFileNameWithoutExtension path, StringComparison.OrdinalIgnoreCase) = 0 ->
                           ()
                       | Some _, _ ->
-                          for t in GetTypeProviderImplementationTypes (runTimeAssemblyFileName, designTimeAssemblyNameString, m) do
+                          for t in GetTypeProviderImplementationTypes (runTimeAssemblyFileName, designTimeAssemblyNameString, m, compilerToolPaths) do
                             let resolver = CreateTypeProvider (t, runTimeAssemblyFileName, resolutionEnvironment, isInvalidationSupported, isInteractive, systemRuntimeContainsType, systemRuntimeAssemblyVersion, m)
                             match box resolver with 
                             | null -> ()
@@ -223,7 +234,7 @@ module internal ExtensionTyping =
                           () ]
 
                 with :? TypeProviderError as tpe ->
-                    tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) )                        
+                    tpe.Iter(fun e -> errorR(NumberedError((e.Number, e.ContextualErrorMessage), m)) )
                     []
 
         let providers = Tainted<_>.CreateAll providerSpecs

src/fsharp/ExtensionTyping.fsi

@@ -54,6 +54,7 @@ module internal ExtensionTyping =
           * 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.

src/fsharp/FSComp.txt

@@ -846,6 +846,7 @@ optsNoOpt,"Only include optimization information essential for implementing inli
 optsNoInterface,"Don't add a resource to the generated assembly containing F#-specific metadata"
 optsSig,"Print the inferred interface of the assembly to a file"
 optsReference,"Reference an assembly (Short form: -r)"
+optsCompilerTool,"Reference an assembly or diretory containing a design time tool (Short form: -t)"
 optsWin32res,"Specify a Win32 resource file (.res)"
 optsWin32manifest,"Specify a Win32 manifest file"
 optsNowin32manifest,"Do not include the default Win32 manifest"

src/fsharp/FSharp.Build/Fsc.fs

@@ -27,6 +27,7 @@ type public Fsc () as this =
     let mutable checksumAlgorithm: string = null
     let mutable codePage : string = null
     let mutable commandLineArgs : ITaskItem list = []
+    let mutable compilerTools: ITaskItem [] = [||]
     let mutable debugSymbols = false
     let mutable debugType : string = null
     let mutable defineConstants : ITaskItem[] = [||]
@@ -162,6 +163,12 @@ type public Fsc () as this =
 
         // VersionFile
         builder.AppendSwitchIfNotNull("--versionfile:", versionFile)
+
+        // CompilerTools
+        if compilerTools <> null then 
+            for item in compilerTools do
+                builder.AppendSwitchIfNotNull("--compilertool:", item.ItemSpec)
+
         // References
         if references <> null then 
             for item in references do
@@ -276,6 +283,11 @@ type public Fsc () as this =
         with get() = codePage
         and set(s) = codePage <- s
 
+    // -r <string>: Reference an F# or .NET assembly.
+    member fsc.CompilerTools
+        with get() = compilerTools
+        and set(a) = compilerTools <- a
+
     // -g: Produce debug file. Disables optimizations if a -O flag is not given.
     member fsc.DebugSymbols
         with get() = debugSymbols

src/fsharp/FSharp.Build/Microsoft.FSharp.Targets

@@ -210,6 +210,7 @@ this file.
                 @(CompileBefore);
                 @(Compile);
                 @(CompileAfter);
+                @(CompilerToolsFscCompilerTools);
                 @(_CoreCompileResourceInputs);
                 @(ManifestNonResxWithNoCultureOnDisk);
                 $(ApplicationIcon);
@@ -278,6 +279,7 @@ this file.
               BaseAddress="$(BaseAddress)"
               ChecksumAlgorithm="$(PdbChecksumAlgorithm)"
               CodePage="$(CodePage)"
+              CompilerTools="$(FscCompilerTools)"
               DebugSymbols="$(DebugSymbols)"
               DebugType="$(DebugType)"
               DefineConstants="$(DefineConstants)"

tests/fsharpqa/Source/CompilerOptions/fsc/help/help40.437.1033.bsl

@@ -40,8 +40,9 @@ Copyright (c) Microsoft Corporation. All Rights Reserved.
 
 
 		- INPUT FILES -
---reference:<file>                       Reference an assembly (Short form:
-                                         -r)
+--reference:<file>                       Reference an assembly (Short form: -r)
+--compilertool:<file>                    Reference an assembly or diretory containing a
+                                         design time tool (Short form: -t)
 
 
 		- RESOURCES -