From ef0473c04f7e497eb4a401cb08a379ed1568a251 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 17 Mar 2017 14:10:59 -0500 Subject: [PATCH 1/5] Initial commit of F# compiler integration --- src/fsharp/CompileOps.fs | 133 ++++++++--- src/fsharp/CompileOps.fsi | 6 +- src/fsharp/DependencyManager.Integration.fs | 223 ++++++++++++++++++ src/fsharp/DependencyManager.Integration.fsi | 29 +++ src/fsharp/FSComp.txt | 2 + .../FSharp.Compiler-proto.fsproj | 6 + .../FSharp.Compiler/FSharp.Compiler.fsproj | 8 +- .../FSharp.LanguageService.Compiler.fsproj | 8 +- src/fsharp/fsi/fsi.fs | 90 +++++-- .../Misc/UnknownDependencyManager/script1.fsx | 5 + .../Source/InteractiveSession/Misc/env.lst | 3 + tests/fsharpqa/Source/test.lst | 1 + 12 files changed, 461 insertions(+), 53 deletions(-) create mode 100644 src/fsharp/DependencyManager.Integration.fs create mode 100644 src/fsharp/DependencyManager.Integration.fsi create mode 100644 tests/fsharpqa/Source/InteractiveSession/Misc/UnknownDependencyManager/script1.fsx diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 27db98d802b..d3e7626f99c 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -85,7 +85,6 @@ let FSharpScriptFileSuffixes = [".fsscript";".fsx"] let doNotRequireNamespaceOrModuleSuffixes = [".mli";".ml"] @ FSharpScriptFileSuffixes let FSharpLightSyntaxFileSuffixes : string list = [ ".fs";".fsscript";".fsx";".fsi" ] - //---------------------------------------------------------------------------- // ERROR REPORTING //-------------------------------------------------------------------------- @@ -2026,8 +2025,9 @@ type TcConfigBuilder = mutable implicitlyResolveAssemblies: bool mutable light: bool option mutable conditionalCompilationDefines: string list - mutable loadedSources: (range * string) list + mutable loadedSources: (range * string * string) list mutable referencedDLLs : AssemblyReference list + mutable packageManagerLines : Map mutable projectReferences : IProjectReference list mutable knownUnresolvedReferences : UnresolvedAssemblyReference list optimizeForMemory: bool @@ -2190,6 +2190,7 @@ type TcConfigBuilder = framework=true implicitlyResolveAssemblies=true referencedDLLs = [] + packageManagerLines = Map.empty projectReferences = [] knownUnresolvedReferences = [] loadedSources = [] @@ -2379,18 +2380,18 @@ type TcConfigBuilder = if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath - member tcConfigB.AddLoadedSource(m,path,pathLoadedFrom) = - if FileSystem.IsInvalidPathShim(path) then - warning(Error(FSComp.SR.buildInvalidFilename(path),m)) + member tcConfigB.AddLoadedSource(m,originalPath,pathLoadedFrom) = + if FileSystem.IsInvalidPathShim(originalPath) then + warning(Error(FSComp.SR.buildInvalidFilename(originalPath),m)) else let path = - match TryResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom],m,path) with + match TryResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom],m,originalPath) with | Some(path) -> path | None -> // File doesn't exist in the paths. Assume it will be in the load-ed from directory. - ComputeMakePathAbsolute pathLoadedFrom path - if not (List.contains path (List.map snd tcConfigB.loadedSources)) then - tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m,path) + ComputeMakePathAbsolute pathLoadedFrom originalPath + if not (List.contains path (List.map (fun (_,_,path) -> path) tcConfigB.loadedSources)) then + tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m,originalPath,path) member tcConfigB.AddEmbeddedSourceFile (file) = tcConfigB.embedSourceList <- tcConfigB.embedSourceList ++ file @@ -2405,6 +2406,13 @@ type TcConfigBuilder = let projectReference = tcConfigB.projectReferences |> List.tryPick (fun pr -> if pr.FileName = path then Some pr else None) tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m,path,projectReference) + member tcConfigB.AddDependencyManagerText (packageManager:DependencyManagerIntegration.IDependencyManagerProvider,m,path:string) = + let path = DependencyManagerIntegration.removeDependencyManagerKey packageManager.Key path + + match tcConfigB.packageManagerLines |> Map.tryFind packageManager.Key with + | Some lines -> tcConfigB.packageManagerLines <- Map.add packageManager.Key (lines ++ (path,m)) tcConfigB.packageManagerLines + | _ -> tcConfigB.packageManagerLines <- Map.add packageManager.Key [path,m] tcConfigB.packageManagerLines + member tcConfigB.RemoveReferencedAssemblyByPath (m,path) = tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs |> List.filter (fun ar-> ar.Range <> m || ar.Text <> path) @@ -2746,6 +2754,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member x.embedAllSource = data.embedAllSource member x.embedSourceList = data.embedSourceList member x.sourceLink = data.sourceLink + member x.packageManagerLines = data.packageManagerLines member x.ignoreSymbolStoreSequencePoints = data.ignoreSymbolStoreSequencePoints member x.internConstantStrings = data.internConstantStrings member x.extraOptimizationIterations = data.extraOptimizationIterations @@ -2855,13 +2864,23 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.GetAvailableLoadedSources() = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - let resolveLoadedSource (m,path) = + let resolveLoadedSource (m,originalPath,path) = try if not(FileSystem.SafeExists(path)) then - error(LoadedSourceNotFoundIgnoring(path,m)) - None + let secondTrial = + tcConfig.includes + |> List.tryPick (fun root -> + let path = ComputeMakePathAbsolute root originalPath + if FileSystem.SafeExists(path) then Some path else None) + + match secondTrial with + | Some path -> Some(m,path) + | None -> + error(LoadedSourceNotFoundIgnoring(path,m)) + None else Some(m,path) with e -> errorRecovery e m; None + tcConfig.loadedSources |> List.choose resolveLoadedSource |> List.distinct @@ -4619,11 +4638,10 @@ let RequireDLL (ctok, tcImports:TcImports, tcEnv, thisAssemblyName, m, file) = let tcEnv = (tcEnv, asms) ||> List.fold (fun tcEnv asm -> AddCcuToTcEnv(g,amap,m,tcEnv,thisAssemblyName,asm.FSharpViewOfMetadata,asm.AssemblyAutoOpenAttributes,asm.AssemblyInternalsVisibleToAttributes)) tcEnv,(dllinfos,asms) - - let ProcessMetaCommandsFromInput (nowarnF: 'state -> range * string -> 'state, dllRequireF: 'state -> range * string -> 'state, + packageRequireF: 'state -> DependencyManagerIntegration.IDependencyManagerProvider * range * string -> 'state, loadSourceF: 'state -> range * string -> unit) (tcConfig:TcConfigBuilder, inp, pathOfMetaCommandSource, state0) = @@ -4651,13 +4669,20 @@ let ProcessMetaCommandsFromInput state | ParsedHashDirective("nowarn",numbers,m) -> List.fold (fun state d -> nowarnF state (m,d)) state numbers + | ParsedHashDirective(("reference" | "r"),args,m) -> if not canHaveScriptMetaCommands then errorR(HashReferenceNotAllowedInNonScript(m)) match args with | [path] -> matchedm<-m - dllRequireF state (m,path) + match DependencyManagerIntegration.tryFindDependencyManagerInPath m (path:string) with + | DependencyManagerIntegration.ReferenceType.RegisteredDependencyManager packageManager -> + packageRequireF state (packageManager,m,path) + | DependencyManagerIntegration.ReferenceType.Library path -> + dllRequireF state (m,path) + | DependencyManagerIntegration.ReferenceType.UnknownType -> + state // error already reported | _ -> errorR(Error(FSComp.SR.buildInvalidHashrDirective(),m)) state @@ -4736,8 +4761,9 @@ let ApplyNoWarnsToTcConfig (tcConfig:TcConfig, inp:ParsedInput, pathOfMetaComman let tcConfigB = tcConfig.CloneOfOriginalBuilder let addNoWarn = fun () (m,s) -> tcConfigB.TurnWarningOff(m, s) let addReferencedAssemblyByPath = fun () (_m,_s) -> () + let addDependencyManagerText = fun () (_prefix,_m,_s) -> () let addLoadedSource = fun () (_m,_s) -> () - ProcessMetaCommandsFromInput (addNoWarn, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) + ProcessMetaCommandsFromInput (addNoWarn, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate=false) let ApplyMetaCommandsFromInputToTcConfig (tcConfig:TcConfig, inp:ParsedInput, pathOfMetaCommandSource) = @@ -4745,8 +4771,9 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig:TcConfig, inp:ParsedInput, pa let tcConfigB = tcConfig.CloneOfOriginalBuilder let getWarningNumber = fun () _ -> () let addReferencedAssemblyByPath = fun () (m,s) -> tcConfigB.AddReferencedAssemblyByPath(m,s) + let addDependencyManagerText = fun () (packageManager, m,s) -> tcConfigB.AddDependencyManagerText(packageManager,m,s) let addLoadedSource = fun () (m,s) -> tcConfigB.AddLoadedSource(m,s,pathOfMetaCommandSource) - ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) + ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate=false) //---------------------------------------------------------------------------- @@ -4795,8 +4822,7 @@ type CodeContext = | Compilation // in fsc.exe | Editing // in VS - -module private ScriptPreprocessClosure = +module ScriptPreprocessClosure = open Internal.Utilities.Text.Lexing /// Represents an input to the closure finding process @@ -4876,9 +4902,10 @@ module private ScriptPreprocessClosure = let nowarns = ref [] let getWarningNumber = fun () (m,s) -> nowarns := (s,m) :: !nowarns let addReferencedAssemblyByPath = fun () (m,s) -> tcConfigB.AddReferencedAssemblyByPath(m,s) + let addDependencyManagerText = fun () (packageManagerPrefix,m,s) -> tcConfigB.AddDependencyManagerText(packageManagerPrefix,m,s) let addLoadedSource = fun () (m,s) -> tcConfigB.AddLoadedSource(m,s,pathOfMetaCommandSource) try - ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) + ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addDependencyManagerText, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) with ReportedError _ -> // Recover by using whatever did end up in the tcConfig () @@ -4890,12 +4917,50 @@ module private ScriptPreprocessClosure = let tcConfigB = tcConfig.CloneOfOriginalBuilder TcConfig.Create(tcConfigB, validate=false),nowarns - let FindClosureFiles(closureSources, tcConfig:TcConfig, codeContext, lexResourceManager:Lexhelp.LexResourceManager) = - let tcConfig = ref tcConfig + let FindClosureFiles(_mainFile, _m, closureSources, origTcConfig:TcConfig, codeContext, lexResourceManager:Lexhelp.LexResourceManager) = + let tcConfig = ref origTcConfig let observedSources = Observed() - let rec loop (ClosureSource(filename,m,source,parseRequired)) = - [ if not (observedSources.HaveSeen(filename)) then + let loadScripts = HashSet<_>() + + // Resolve the packages + let rec resolveDependencyManagerSources scriptName = + if not (loadScripts.Contains scriptName) then + [ for kv in tcConfig.Value.packageManagerLines do + let packageManagerKey,packageManagerLines = kv.Key,kv.Value + match packageManagerLines with + | [] -> () + | (_,m)::_ -> + match origTcConfig.packageManagerLines |> Map.tryFind packageManagerKey with + | Some oldDependencyManagerLines when oldDependencyManagerLines = packageManagerLines -> () + | _ -> + match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey with + | None -> + errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m) + | Some packageManager -> + let packageManagerTextLines = packageManagerLines |> List.map fst + match DependencyManagerIntegration.resolve packageManager tcConfig.Value.implicitIncludeDir scriptName m packageManagerTextLines with + | None -> () // error already reported + | Some (loadScript,additionalIncludeFolders) -> + // This may incrementally update tcConfig too with new #r references + // New package text is ignored on this second phase + + if not (isNil additionalIncludeFolders) then + let tcConfigB = tcConfig.Value.CloneOfOriginalBuilder + for folder in additionalIncludeFolders do + tcConfigB.AddIncludePath(m,folder,"") + tcConfig := TcConfig.Create(tcConfigB, validate=false) + + match loadScript with + | Some loadScript -> + let loadScriptText = File.ReadAllText loadScript + loadScripts.Add loadScript |> ignore + yield! loop (ClosureSource(loadScript,m,loadScriptText,true)) + | None -> () ] + else [] + + and loop (ClosureSource(filename,m,source,parseRequired)) = + [ if not (observedSources.HaveSeen(filename)) then observedSources.SetSeen(filename) //printfn "visiting %s" filename if IsScript(filename) || parseRequired then @@ -4910,17 +4975,21 @@ module private ScriptPreprocessClosure = let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let pathOfMetaCommandSource = Path.GetDirectoryName(filename) + let preSources = (!tcConfig).GetAvailableLoadedSources() let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (!tcConfig, parsedScriptAst, pathOfMetaCommandSource) tcConfig := tcConfigResult // We accumulate the tcConfig in order to collect assembly references - + + yield! resolveDependencyManagerSources filename + let postSources = (!tcConfig).GetAvailableLoadedSources() let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] + yield! resolveDependencyManagerSources filename + //for (_,subFile) in sources do // printfn "visiting %s - has subsource of %s " filename subFile - for (m,subFile) in sources do if IsScript(subFile) then for subSource in ClosureSourceOfFilename(subFile,m,tcConfigResult.inputCodePage,false) do @@ -4939,7 +5008,9 @@ module private ScriptPreprocessClosure = //printfn "yielding non-script source %s" filename yield ClosureFile(filename, m, None, [], [], []) ] - closureSources |> List.collect loop, !tcConfig + let sources = closureSources |> List.collect loop + + sources, !tcConfig /// Reduce the full directive closure into LoadClosure let GetLoadClosure(ctok, rootFilename, closureFiles, tcConfig:TcConfig, codeContext) = @@ -4994,7 +5065,7 @@ module private ScriptPreprocessClosure = UnresolvedReferences = unresolvedReferences Inputs = sourceInputs NoWarns = List.groupByFirst globalNoWarns - OriginalLoadReferences = tcConfig.loadedSources + OriginalLoadReferences = tcConfig.loadedSources |> List.map (fun (m,_,path) -> m,path) ResolutionDiagnostics = resolutionDiagnostics AllRootFileDiagnostics = allRootDiagnostics LoadClosureRootFileDiagnostics = loadClosureRootDiagnostics } @@ -5016,15 +5087,15 @@ module private ScriptPreprocessClosure = let tcConfig = CreateScriptSourceTcConfig(referenceResolver, filename, codeContext, useSimpleResolution, useFsiAuxLib, Some references0, applyCommmandLineArgs, assumeDotNetFramework) let closureSources = [ClosureSource(filename,range0,source,true)] - let closureFiles,tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) + let closureFiles,tcConfig = FindClosureFiles(filename, range0, closureSources, tcConfig, codeContext, lexResourceManager) GetLoadClosure(ctok, filename, closureFiles, tcConfig, codeContext) /// Given source filename, find the full load closure /// Used from fsi.fs and fsc.fs, for #load and command line let GetFullClosureOfScriptFiles(ctok, tcConfig:TcConfig,files:(string*range) list,codeContext,lexResourceManager:Lexhelp.LexResourceManager) = - let mainFile = fst (List.last files) + let mainFile, mainFileRange = List.last files let closureSources = files |> List.collect (fun (filename,m) -> ClosureSourceOfFilename(filename,m,tcConfig.inputCodePage,true)) - let closureFiles,tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) + let closureFiles,tcConfig = FindClosureFiles(mainFile, mainFileRange, closureSources, tcConfig, codeContext, lexResourceManager) GetLoadClosure(ctok, mainFile, closureFiles, tcConfig, codeContext) type LoadClosure with diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 95b4e178bea..b1da48cf4da 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -257,9 +257,11 @@ type TcConfigBuilder = mutable light: bool option mutable conditionalCompilationDefines: string list /// Sources added into the build with #load - mutable loadedSources: (range * string) list + mutable loadedSources: (range * string * string) list mutable referencedDLLs: AssemblyReference list + mutable packageManagerLines : Map + mutable projectReferences : IProjectReference list mutable knownUnresolvedReferences : UnresolvedAssemblyReference list optimizeForMemory: bool @@ -660,7 +662,7 @@ val RequireDLL : CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: /// Processing # commands val ProcessMetaCommandsFromInput : - (('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> range * string -> unit)) + (('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> DependencyManagerIntegration.IDependencyManagerProvider * range * string -> 'T) * ('T -> range * string -> unit)) -> TcConfigBuilder * Ast.ParsedInput * string * 'T -> 'T diff --git a/src/fsharp/DependencyManager.Integration.fs b/src/fsharp/DependencyManager.Integration.fs new file mode 100644 index 00000000000..c126c3056e3 --- /dev/null +++ b/src/fsharp/DependencyManager.Integration.fs @@ -0,0 +1,223 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +/// Helper members to integrate DependencyManagers into F# codebase +module internal Microsoft.FSharp.Compiler.DependencyManagerIntegration + +open System +open System.Reflection +open System.IO +open Microsoft.FSharp.Compiler.ErrorLogger + +// NOTE: this contains mostly members whose intents are : +// * to keep ReferenceLoading.PaketHandler usable outside of F# (so it can be used in scriptcs & others) +// * to minimize footprint of integration in fsi/CompileOps + +/// hardcoded to net461 as we don't have fsi on netcore +let targetFramework = "net461" + +module ReflectionHelper = + let assemblyHasAttribute (theAssembly: Assembly) attributeName = + try + theAssembly.GetCustomAttributes false + |> Seq.tryFind (fun a -> a.GetType().Name = attributeName) + |> function | Some _ -> true | _ -> false + with | _ -> false + + let getAttributeNamed (theType: Type) attributeName = + try + theType.GetCustomAttributes false + |> Seq.tryFind (fun a -> a.GetType().Name = attributeName) + with | _ -> None + + let getInstanceProperty<'treturn> (theType: Type) indexParameterTypes propertyName = + try + let property = theType.GetProperty(propertyName, typeof<'treturn>) + if isNull property then + None + elif not (property.GetGetMethod().IsStatic) + && property.GetIndexParameters() = indexParameterTypes + then + Some property + else + None + with | _ -> None + + let getInstanceMethod<'treturn> (theType: Type) (parameterTypes: Type array) methodName = + try + let theMethod = theType.GetMethod(methodName, parameterTypes) + if isNull theMethod then + None + else + Some theMethod + with | _ -> None + + let implements<'timplemented> (theType: Type) = + typeof<'timplemented>.IsAssignableFrom(theType) + +(* this is the loose contract for now, just to define the shape, but this is resolved through reflection *) +type internal IDependencyManagerProvider = + inherit System.IDisposable + abstract Name : string + abstract ToolName: string + abstract Key: string + abstract ResolveDependencies : targetFramework: string * scriptDir: string * scriptName: string * packageManagerTextLines: string seq -> string option * string list + +[] +type ReferenceType = +| RegisteredDependencyManager of IDependencyManagerProvider +| Library of string +| UnknownType + +type ReflectionDependencyManagerProvider(theType: Type, nameProperty: PropertyInfo, toolNameProperty: PropertyInfo, keyProperty: PropertyInfo, resolveDeps: MethodInfo) = + let instance = Activator.CreateInstance(theType) :?> IDisposable + let nameProperty = nameProperty.GetValue >> string + let toolNameProperty = toolNameProperty.GetValue >> string + let keyProperty = keyProperty.GetValue >> string + static member InstanceMaker (theType: System.Type) = + if not (ReflectionHelper.implements theType) then None + else + match ReflectionHelper.getAttributeNamed theType "FSharpDependencyManagerAttribute" with + | None -> None + | Some _ -> + match ReflectionHelper.getInstanceProperty theType Array.empty "Name" with + | None -> None + | Some nameProperty -> + match ReflectionHelper.getInstanceProperty theType Array.empty "ToolName" with + | None -> None + | Some toolNameProperty -> + match ReflectionHelper.getInstanceProperty theType Array.empty "Key" with + | None -> None + | Some keyProperty -> + match ReflectionHelper.getInstanceMethod theType [|typeof;typeof;typeof;typeof;|] "ResolveDependencies" with + | None -> None + | Some resolveDependenciesMethod -> + Some (fun () -> new ReflectionDependencyManagerProvider(theType, nameProperty, toolNameProperty, keyProperty, resolveDependenciesMethod) :> IDependencyManagerProvider) + + interface IDependencyManagerProvider with + member __.Name = instance |> nameProperty + member __.ToolName = instance |> toolNameProperty + member __.Key = instance |> keyProperty + member __.ResolveDependencies(targetFramework, scriptDir, scriptName, packageManagerTextLines) = + let arguments = [|box targetFramework; box scriptDir; box scriptName; box packageManagerTextLines|] + resolveDeps.Invoke(instance, arguments) :?> _ + interface IDisposable with + member __.Dispose () = instance.Dispose() + + +let assemblySearchPaths = + lazy( + [let assemblyLocation = typeof.Assembly.Location + yield Path.GetDirectoryName assemblyLocation + let executingAssembly = Assembly.GetExecutingAssembly().Location + yield Path.GetDirectoryName executingAssembly + let baseDir = AppDomain.CurrentDomain.BaseDirectory + yield baseDir ] + |> List.distinct + ) + +let enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation () = + assemblySearchPaths.Force() + |> Seq.collect (fun path -> Directory.EnumerateFiles(path,"*DependencyManager*.dll")) + |> Seq.choose (fun path -> try Assembly.LoadFrom path |> Some with | _ -> None) + |> Seq.filter (fun a -> ReflectionHelper.assemblyHasAttribute a "FSharpDependencyManagerAttribute") + +type ProjectDependencyManager() = + interface IDependencyManagerProvider with + member __.Name = "Project loader" + member __.ToolName = "" + member __.Key = "project" + member __.ResolveDependencies(_targetFramework:string, _scriptDir: string, _scriptName: string, _packageManagerTextLines: string seq) = + None,[] + + interface System.IDisposable with + member __.Dispose() = () + +type RefDependencyManager() = + interface IDependencyManagerProvider with + member __.Name = "Ref library loader" + member __.ToolName = "" + member __.Key = "ref" + member __.ResolveDependencies(_targetFramework:string, _scriptDir: string, _scriptName: string, _packageManagerTextLines: string seq) = + None,[] + + interface System.IDisposable with + member __.Dispose() = () + +type ImplDependencyManager() = + interface IDependencyManagerProvider with + member __.Name = "Impl library loader" + member __.ToolName = "" + member __.Key = "impl" + member __.ResolveDependencies(_targetFramework:string, _scriptDir: string, _scriptName: string, _packageManagerTextLines: string seq) = + None,[] + + interface System.IDisposable with + member __.Dispose() = () + +let registeredDependencyManagers = lazy ( + let defaultProviders = + [new ProjectDependencyManager() :> IDependencyManagerProvider + new RefDependencyManager() :> IDependencyManagerProvider + new ImplDependencyManager() :> IDependencyManagerProvider] + + let loadedProviders = + enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation() + |> Seq.collect (fun a -> a.GetTypes()) + |> Seq.choose ReflectionDependencyManagerProvider.InstanceMaker + |> Seq.map (fun maker -> maker ()) + + defaultProviders + |> Seq.append loadedProviders + |> Seq.map (fun pm -> pm.Key, pm) + |> Map.ofSeq +) + +let RegisteredDependencyManagers() = registeredDependencyManagers.Force() + +let createPackageManagerUnknownError packageManagerKey m = + let registeredKeys = String.Join(", ", RegisteredDependencyManagers() |> Seq.map (fun kv -> kv.Value.Key)) + let searchPaths = assemblySearchPaths.Force() + Error(FSComp.SR.packageManagerUnknown(packageManagerKey, String.Join(", ", searchPaths), registeredKeys),m) + +let tryFindDependencyManagerInPath m (path:string) : ReferenceType = + try + if path.Contains ":" then + let managers = RegisteredDependencyManagers() + match managers |> Seq.tryFind (fun kv -> path.StartsWith(kv.Value.Key + ":" )) with + | None -> + errorR(createPackageManagerUnknownError (path.Split(':').[0]) m) + ReferenceType.UnknownType + | Some kv -> ReferenceType.RegisteredDependencyManager kv.Value + else + ReferenceType.Library path + with + | e -> + errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) + ReferenceType.UnknownType + +let removeDependencyManagerKey (packageManagerKey:string) (path:string) = path.Substring(packageManagerKey.Length + 1).Trim() + +let tryFindDependencyManagerByKey m (key:string) : IDependencyManagerProvider option = + try + RegisteredDependencyManagers() |> Map.tryFind key + with + | e -> + errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) + None + +let resolve (packageManager:IDependencyManagerProvider) implicitIncludeDir fileName m packageManagerTextLines = + try + let loadScript,additionalIncludeFolders = + packageManager.ResolveDependencies( + targetFramework, + implicitIncludeDir, + fileName, + packageManagerTextLines) + + Some(loadScript,additionalIncludeFolders) + with e -> + if e.InnerException <> null then + errorR(Error(FSComp.SR.packageManagerError(e.InnerException.Message),m)) + else + errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) + None \ No newline at end of file diff --git a/src/fsharp/DependencyManager.Integration.fsi b/src/fsharp/DependencyManager.Integration.fsi new file mode 100644 index 00000000000..3419a9e65f2 --- /dev/null +++ b/src/fsharp/DependencyManager.Integration.fsi @@ -0,0 +1,29 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +/// Helper members to integrate DependencyManagers into F# codebase +module internal Microsoft.FSharp.Compiler.DependencyManagerIntegration + +open Microsoft.FSharp.Compiler.Range + +type IDependencyManagerProvider = + inherit System.IDisposable + abstract Name : string + abstract ToolName: string + abstract Key: string + abstract ResolveDependencies : string * string * string * string seq -> string option * string list + +[] +type ReferenceType = +| RegisteredDependencyManager of IDependencyManagerProvider +| Library of string +| UnknownType + +val RegisteredDependencyManagers : unit -> Map +val tryFindDependencyManagerInPath : range -> string -> ReferenceType +val tryFindDependencyManagerByKey : range -> string -> IDependencyManagerProvider option + +val removeDependencyManagerKey : string -> string -> string + +val createPackageManagerUnknownError : string -> range -> exn + +val resolve : IDependencyManagerProvider -> string -> string -> range -> string seq -> (string option * string list) option diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 7e931f02d11..e2c09ed1439 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1333,6 +1333,8 @@ tcGlobalsSystemTypeNotFound,"The system type '%s' was required but no referenced 3213,typrelMemberHasMultiplePossibleDispatchSlots,"The member '%s' matches multiple overloads of the same method.\nPlease restrict it to one of the following:%s." 3214,methodIsNotStatic,"Method or object constructor '%s' is not static" 3215,parsUnexpectedSymbolEqualsInsteadOfIn,"Unexpected symbol '=' in expression. Did you intend to use 'for x in y .. z do' instead?" +3216,packageManagerUnknown,"Package manager key '%s' was not registered in %s. Currently registered: %s" +3217,packageManagerError,"%s" keywordDescriptionAbstract,"Indicates a method that either has no implementation in the type in which it is declared or that is virtual and has a default implementation." keyworkDescriptionAnd,"Used in mutually recursive bindings, in property declarations, and with multiple constraints on generic parameters." keywordDescriptionAs,"Used to give the current class object an object name. Also used to give a name to a whole pattern within a pattern match." diff --git a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj index e2fd82d83f3..1a3a2d455be 100644 --- a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj +++ b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj @@ -422,6 +422,12 @@ IlxGen.fs + + Driver\DependencyManager.Integration.fsi + + + Driver\DependencyManager.Integration.fs + CompileOps.fsi diff --git a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj index f5160d9a72b..332c1f6bc8f 100644 --- a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj +++ b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj @@ -493,6 +493,12 @@ CodeGen\IlxGen.fs + + Driver\DependencyManager.Integration.fsi + + + Driver\DependencyManager.Integration.fs + Driver\CompileOps.fsi @@ -593,4 +599,4 @@ FSharp.Core - \ No newline at end of file + diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index 3175db0692a..6292fc5f7b9 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -1,4 +1,4 @@ - + @@ -475,6 +475,12 @@ CodeGen/IlxGen.fs + + Driver\DependencyManager.Integration.fsi + + + Driver\DependencyManager.Integration.fs + Driver\CompileOps.fsi diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 57a4b9f5514..ff83b240d24 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -969,6 +969,8 @@ type internal FsiDynamicCompiler let mutable fragmentId = 0 let mutable prevIt : ValRef option = None + let mutable needsPackageResolution = false + let generateDebugInfo = tcConfigB.debuginfo let valuePrinter = FsiValuePrinter(fsi, tcGlobals, generateDebugInfo, resolveAssemblyRef, outWriter) @@ -1220,6 +1222,43 @@ type internal FsiDynamicCompiler resolutions, { istate with tcState = tcState.NextStateAfterIncrementalFragment(tcEnv); optEnv = optEnv } + + member __.EvalDependencyManagerTextFragment (packageManager:DependencyManagerIntegration.IDependencyManagerProvider,m,path: string) = + let path = DependencyManagerIntegration.removeDependencyManagerKey packageManager.Key path + + match tcConfigB.packageManagerLines |> Map.tryFind packageManager.Key with + | Some lines -> tcConfigB.packageManagerLines <- Map.add packageManager.Key (lines @ [path,m]) tcConfigB.packageManagerLines + | _ -> tcConfigB.packageManagerLines <- Map.add packageManager.Key [path,m] tcConfigB.packageManagerLines + + needsPackageResolution <- true + + member fsiDynamicCompiler.CommitDependencyManagerText (ctok, istate: FsiDynamicCompilerState, lexResourceManager, errorLogger) = + if not needsPackageResolution then istate else + needsPackageResolution <- false + + let istate = ref istate + for kv in tcConfigB.packageManagerLines do + let packageManagerKey,packageManagerLines = kv.Key,kv.Value + match packageManagerLines with + | [] -> () + | (_,m)::_ -> + let packageManagerTextLines = packageManagerLines |> List.map fst + match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey with + | None -> + errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m) + | Some packageManager -> + match DependencyManagerIntegration.resolve packageManager tcConfigB.implicitIncludeDir "stdin.fsx" m packageManagerTextLines with + | None -> () // error already reported + | Some (loadScript,additionalIncludeFolders) -> + for folder in additionalIncludeFolders do + tcConfigB.AddIncludePath(m,folder,"") + + match loadScript with + | Some loadScript -> istate := fsiDynamicCompiler.EvalSourceFiles (ctok, !istate, m, [loadScript], lexResourceManager, errorLogger) + | None -> () + + !istate + member fsiDynamicCompiler.ProcessMetaCommandsFromInputAsInteractiveCommands(ctok, istate, sourceFile, inp) = WithImplicitHome (tcConfigB, directoryName sourceFile) @@ -1227,6 +1266,7 @@ type internal FsiDynamicCompiler ProcessMetaCommandsFromInput ((fun st (m,nm) -> tcConfigB.TurnWarningOff(m,nm); st), (fun st (m,nm) -> snd (fsiDynamicCompiler.EvalRequireReference (ctok, st, m, nm))), + (fun st (packageManagerPrefix,m,nm) -> fsiDynamicCompiler.EvalDependencyManagerTextFragment (packageManagerPrefix,m,nm); st), (fun _ _ -> ())) (tcConfigB, inp, Path.GetDirectoryName sourceFile, istate)) @@ -1864,36 +1904,50 @@ type internal FsiInteractionProcessor istate |> InteractiveCatch errorLogger (fun istate -> match action with | IDefns ([ ],_) -> + let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, errorLogger) istate,Completed None + | IDefns ([ SynModuleDecl.DoExpr(_,expr,_)],_) -> + let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, errorLogger) fsiDynamicCompiler.EvalParsedExpression(ctok, errorLogger, istate, expr) + | IDefns (defs,_) -> + let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, errorLogger) fsiDynamicCompiler.EvalParsedDefinitions (ctok, errorLogger, istate, true, false, defs),Completed None | IHash (ParsedHashDirective("load",sourceFiles,m),_) -> + let istate = fsiDynamicCompiler.CommitDependencyManagerText(ctok, istate, lexResourceManager, errorLogger) fsiDynamicCompiler.EvalSourceFiles (ctok, istate, m, sourceFiles, lexResourceManager, errorLogger),Completed None | IHash (ParsedHashDirective(("reference" | "r"),[path],m),_) -> - let resolutions,istate = fsiDynamicCompiler.EvalRequireReference(ctok, istate, m, path) - resolutions |> List.iter (fun ar -> - let format = + match DependencyManagerIntegration.tryFindDependencyManagerInPath m (path:string) with + | DependencyManagerIntegration.ReferenceType.RegisteredDependencyManager packageManager -> + fsiDynamicCompiler.EvalDependencyManagerTextFragment(packageManager,m,path) + istate,Completed None + | DependencyManagerIntegration.ReferenceType.UnknownType -> + // error already reported + istate,Completed None + | DependencyManagerIntegration.ReferenceType.Library path -> + let resolutions,istate = fsiDynamicCompiler.EvalRequireReference(ctok, istate, m, path) + resolutions |> List.iter (fun ar -> + let format = #if FSI_SHADOW_COPY_REFERENCES - if tcConfig.shadowCopyReferences then - let resolvedPath = ar.resolvedPath.ToUpperInvariant() - let fileTime = File.GetLastWriteTimeUtc(resolvedPath) - match referencedAssemblies.TryGetValue(resolvedPath) with - | false, _ -> - referencedAssemblies.Add(resolvedPath, fileTime) - FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) - | true, time when time <> fileTime -> - FSIstrings.SR.fsiDidAHashrWithStaleWarning(ar.resolvedPath) - | _ -> - FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) - else + if tcConfig.shadowCopyReferences then + let resolvedPath = ar.resolvedPath.ToUpperInvariant() + let fileTime = File.GetLastWriteTimeUtc(resolvedPath) + match referencedAssemblies.TryGetValue(resolvedPath) with + | false, _ -> + referencedAssemblies.Add(resolvedPath, fileTime) + FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) + | true, time when time <> fileTime -> + FSIstrings.SR.fsiDidAHashrWithStaleWarning(ar.resolvedPath) + | _ -> + FSIstrings.SR.fsiDidAHashr(ar.resolvedPath) + else #endif - FSIstrings.SR.fsiDidAHashrWithLockWarning(ar.resolvedPath) - fsiConsoleOutput.uprintnfnn "%s" format) - istate,Completed None + FSIstrings.SR.fsiDidAHashrWithLockWarning(ar.resolvedPath) + fsiConsoleOutput.uprintnfnn "%s" format) + istate,Completed None | IHash (ParsedHashDirective("I",[path],m),_) -> tcConfigB.AddIncludePath (m,path, tcConfig.implicitIncludeDir) diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/UnknownDependencyManager/script1.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/UnknownDependencyManager/script1.fsx new file mode 100644 index 00000000000..38c8173ec88 --- /dev/null +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/UnknownDependencyManager/script1.fsx @@ -0,0 +1,5 @@ +//Package manager key 'unk' was not registered. + +#r "unk: blubblub" + +let x = 1 \ No newline at end of file diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst b/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst index 13803307162..f18e59e67d6 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst @@ -165,3 +165,6 @@ NOMONO SOURCE=Regressions01.fs COMPILE_ONLY=1 FSIMODE=PIPE SCFLAGS="--nologo" SOURCE=..\\Misc\\ccc\\RelativeHashRResolution03_1.fsx COMPILE_ONLY=1 SCFLAGS="--nologo --simpleresolution --noframework -r:\"%FSCOREDLLPATH%\"" # RelativeHashRResolution03_fscrelativesimple SOURCE=..\\Misc\\aaa\\bbb\\RelativeHashRResolution04_1.fsx COMPILE_ONLY=1 SCFLAGS="--nologo --simpleresolution --noframework -r:\"%FSCOREDLLPATH%\"" # RelativeHashRResolution04_fscrelativesimple SOURCE=..\\Misc\\aaa\\bbb\\RelativeHashRResolution05_1.fsx COMPILE_ONLY=1 SCFLAGS="--nologo --simpleresolution --noframework -r:\"%FSCOREDLLPATH%\"" # RelativeHashRResolution05_fscrelativesimple + +# dependency managers +SOURCE="UnknownDependencyManager\\script1.fsx" COMPILE_ONLY=1 FSIMODE=FEED SCFLAGS="--nologo" # with unknown manager \ No newline at end of file diff --git a/tests/fsharpqa/Source/test.lst b/tests/fsharpqa/Source/test.lst index 6345ef46fbf..470d2389d5e 100644 --- a/tests/fsharpqa/Source/test.lst +++ b/tests/fsharpqa/Source/test.lst @@ -250,6 +250,7 @@ Misc01 EntryPoint Misc01 Globalization Misc01,NoMT Import Misc01,NoMT ..\..\..\testsprivate\fsharpqa\Source\InteractiveSession\AssemblyLoading +Misc01,NoMT InteractiveSession\Paket Misc01,NoMT InteractiveSession\Misc Misc01,NoMT InteractiveSession\Misc\GenericConstraintWoes\issue2411 Misc01 Libraries\Control From 16c25d7097695ba820327d05a54248071400ea07 Mon Sep 17 00:00:00 2001 From: Kevin Ransom Date: Mon, 20 Mar 2017 11:26:26 -0500 Subject: [PATCH 2/5] Build on coreclr --- VisualFSharp.sln | 7 ++++--- src/fsharp/DependencyManager.Integration.fs | 14 ++++++++++---- src/utils/reshapedreflection.fs | 3 +++ 3 files changed, 17 insertions(+), 7 deletions(-) diff --git a/VisualFSharp.sln b/VisualFSharp.sln index 42d36f17d85..f5477448456 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 -VisualStudioVersion = 15.0.26206.0 +VisualStudioVersion = 15.0.26228.9 MinimumVisualStudioVersion = 10.0.40219.1 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Compiler", "src\fsharp\FSharp.Compiler\FSharp.Compiler.fsproj", "{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}" EndProject @@ -278,8 +278,9 @@ Global {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44}.Release|Any CPU.Build.0 = Release|Any CPU {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44}.Release|x86.ActiveCfg = Release|Any CPU {6196B0F8-CAEA-4CF1-AF82-1B520F77FE44}.Release|x86.Build.0 = Release|Any CPU - {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|Any CPU.Build.0 = Debug|Any CPU + {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|Any CPU.ActiveCfg = Release|Any CPU + {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|Any CPU.Build.0 = Release|Any CPU + {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|Any CPU.Deploy.0 = Release|Any CPU {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|x86.ActiveCfg = Debug|Any CPU {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Debug|x86.Build.0 = Debug|Any CPU {FBD4B354-DC6E-4032-8EC7-C81D8DFB1AF7}.Proto|Any CPU.ActiveCfg = Proto|Any CPU diff --git a/src/fsharp/DependencyManager.Integration.fs b/src/fsharp/DependencyManager.Integration.fs index c126c3056e3..f740bb07e97 100644 --- a/src/fsharp/DependencyManager.Integration.fs +++ b/src/fsharp/DependencyManager.Integration.fs @@ -8,6 +8,10 @@ open System.Reflection open System.IO open Microsoft.FSharp.Compiler.ErrorLogger +#if FX_RESHAPED_REFLECTION +open Microsoft.FSharp.Core.ReflectionAdapters +#endif + // NOTE: this contains mostly members whose intents are : // * to keep ReferenceLoading.PaketHandler usable outside of F# (so it can be used in scriptcs & others) // * to minimize footprint of integration in fsi/CompileOps @@ -108,10 +112,12 @@ let assemblySearchPaths = lazy( [let assemblyLocation = typeof.Assembly.Location yield Path.GetDirectoryName assemblyLocation - let executingAssembly = Assembly.GetExecutingAssembly().Location - yield Path.GetDirectoryName executingAssembly - let baseDir = AppDomain.CurrentDomain.BaseDirectory - yield baseDir ] +#if FX_NO_APP_DOMAINS + yield AppContext.BaseDirectory +#else + yield AppDomain.CurrentDomain.BaseDirectory +#endif + ] |> List.distinct ) diff --git a/src/utils/reshapedreflection.fs b/src/utils/reshapedreflection.fs index 80e8da9cdcf..2eae59c78cb 100644 --- a/src/utils/reshapedreflection.fs +++ b/src/utils/reshapedreflection.fs @@ -92,6 +92,7 @@ module internal ReflectionAdapters = member this.GetRuntimeProperties() = RuntimeReflectionExtensions.GetRuntimeProperties(this) member this.GetRuntimeEvents() = RuntimeReflectionExtensions.GetRuntimeEvents(this) member this.Attributes = this.GetTypeInfo().Attributes + member this.GetCustomAttributes(inherits:bool) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), inherits) |> Seq.toArray) member this.GetCustomAttributes(attrTy, inherits) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attrTy, inherits) |> Seq.toArray) member this.GetNestedType (name, bindingFlags) = // MSDN: http://msdn.microsoft.com/en-us/library/0dcb3ad5.aspx @@ -340,6 +341,8 @@ module internal ReflectionAdapters = |> Seq.toArray member this.Location = this.ManifestModule.FullyQualifiedName + member this.GetCustomAttributes(_:bool) = + CustomAttributeExtensions.GetCustomAttributes(this) |> Seq.toArray #if FX_RESHAPED_REFLECTION_CORECLR static member LoadFrom(filename:string) = From 4c02ef108b508974c010b88e6c20a107a1508239 Mon Sep 17 00:00:00 2001 From: Kevin Ransom Date: Mon, 20 Mar 2017 16:39:28 -0500 Subject: [PATCH 3/5] Requires dmkey to be 2 or more characters, this allows rooted paths similar to c:\ to work on windows. --- src/fsharp/DependencyManager.Integration.fs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/fsharp/DependencyManager.Integration.fs b/src/fsharp/DependencyManager.Integration.fs index f740bb07e97..ce0fd1bbe5b 100644 --- a/src/fsharp/DependencyManager.Integration.fs +++ b/src/fsharp/DependencyManager.Integration.fs @@ -187,17 +187,18 @@ let createPackageManagerUnknownError packageManagerKey m = let tryFindDependencyManagerInPath m (path:string) : ReferenceType = try - if path.Contains ":" then + match path.IndexOf(":") with + | -1 | 1 -> + ReferenceType.Library path + | _ -> let managers = RegisteredDependencyManagers() match managers |> Seq.tryFind (fun kv -> path.StartsWith(kv.Value.Key + ":" )) with | None -> errorR(createPackageManagerUnknownError (path.Split(':').[0]) m) ReferenceType.UnknownType | Some kv -> ReferenceType.RegisteredDependencyManager kv.Value - else - ReferenceType.Library path - with - | e -> + with + | e -> errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) ReferenceType.UnknownType From eb58bec3f3c17876789f35dc8c0ea7d0a57c8972 Mon Sep 17 00:00:00 2001 From: Kevin Ransom Date: Mon, 20 Mar 2017 22:47:34 -0500 Subject: [PATCH 4/5] Identify correct test --- tests/fsharpqa/Source/test.lst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/test.lst b/tests/fsharpqa/Source/test.lst index 470d2389d5e..031e2d2fa0f 100644 --- a/tests/fsharpqa/Source/test.lst +++ b/tests/fsharpqa/Source/test.lst @@ -250,7 +250,7 @@ Misc01 EntryPoint Misc01 Globalization Misc01,NoMT Import Misc01,NoMT ..\..\..\testsprivate\fsharpqa\Source\InteractiveSession\AssemblyLoading -Misc01,NoMT InteractiveSession\Paket +Misc01,NoMT InteractiveSession\UnknownDependencyManager Misc01,NoMT InteractiveSession\Misc Misc01,NoMT InteractiveSession\Misc\GenericConstraintWoes\issue2411 Misc01 Libraries\Control From cc8df38355f1ac7814c47c9a6c5f0f2f47767639 Mon Sep 17 00:00:00 2001 From: Kevin Ransom Date: Wed, 19 Apr 2017 22:20:23 -0500 Subject: [PATCH 5/5] add --lib paths to dependency manager search heuristic --- src/fsharp/CompileOps.fs | 6 +- src/fsharp/DependencyManager.Integration.fs | 150 +++++++++---------- src/fsharp/DependencyManager.Integration.fsi | 14 +- src/fsharp/fsi/fsi.fs | 10 +- 4 files changed, 89 insertions(+), 91 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index d9ca726bfe1..be4bb42f5c2 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -4725,7 +4725,7 @@ let ProcessMetaCommandsFromInput match args with | [path] -> matchedm<-m - match DependencyManagerIntegration.tryFindDependencyManagerInPath m (path:string) with + match DependencyManagerIntegration.tryFindDependencyManagerInPath m path tcConfig.includes with | DependencyManagerIntegration.ReferenceType.RegisteredDependencyManager packageManager -> packageRequireF state (packageManager,m,path) | DependencyManagerIntegration.ReferenceType.Library path -> @@ -4983,9 +4983,9 @@ module ScriptPreprocessClosure = match origTcConfig.packageManagerLines |> Map.tryFind packageManagerKey with | Some oldDependencyManagerLines when oldDependencyManagerLines = packageManagerLines -> () | _ -> - match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey with + match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey origTcConfig.includes with | None -> - errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m) + errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m origTcConfig.includes) | Some packageManager -> let packageManagerTextLines = packageManagerLines |> List.map fst match DependencyManagerIntegration.resolve packageManager tcConfig.Value.implicitIncludeDir scriptName m packageManagerTextLines with diff --git a/src/fsharp/DependencyManager.Integration.fs b/src/fsharp/DependencyManager.Integration.fs index ce0fd1bbe5b..3c3c9dbb38f 100644 --- a/src/fsharp/DependencyManager.Integration.fs +++ b/src/fsharp/DependencyManager.Integration.fs @@ -19,8 +19,9 @@ open Microsoft.FSharp.Core.ReflectionAdapters /// hardcoded to net461 as we don't have fsi on netcore let targetFramework = "net461" +/// reflection helpers module ReflectionHelper = - let assemblyHasAttribute (theAssembly: Assembly) attributeName = + let assemblyHasAttributeNamed (theAssembly: Assembly) attributeName = try theAssembly.GetCustomAttributes false |> Seq.tryFind (fun a -> a.GetType().Name = attributeName) @@ -58,7 +59,8 @@ module ReflectionHelper = let implements<'timplemented> (theType: Type) = typeof<'timplemented>.IsAssignableFrom(theType) -(* this is the loose contract for now, just to define the shape, but this is resolved through reflection *) +/// Contract for dependency anager provider. This is a loose contract for now, just to define the shape, +/// it is resolved through reflection (ReflectionDependencyManagerProvider) type internal IDependencyManagerProvider = inherit System.IDisposable abstract Name : string @@ -66,36 +68,33 @@ type internal IDependencyManagerProvider = abstract Key: string abstract ResolveDependencies : targetFramework: string * scriptDir: string * scriptName: string * packageManagerTextLines: string seq -> string option * string list +/// Reference [] type ReferenceType = | RegisteredDependencyManager of IDependencyManagerProvider | Library of string | UnknownType +/// Dependency Manager Provider using dotnet reflection type ReflectionDependencyManagerProvider(theType: Type, nameProperty: PropertyInfo, toolNameProperty: PropertyInfo, keyProperty: PropertyInfo, resolveDeps: MethodInfo) = let instance = Activator.CreateInstance(theType) :?> IDisposable let nameProperty = nameProperty.GetValue >> string let toolNameProperty = toolNameProperty.GetValue >> string let keyProperty = keyProperty.GetValue >> string - static member InstanceMaker (theType: System.Type) = + static member InstanceMaker (theType: System.Type) = if not (ReflectionHelper.implements theType) then None - else - match ReflectionHelper.getAttributeNamed theType "FSharpDependencyManagerAttribute" with - | None -> None - | Some _ -> - match ReflectionHelper.getInstanceProperty theType Array.empty "Name" with - | None -> None - | Some nameProperty -> - match ReflectionHelper.getInstanceProperty theType Array.empty "ToolName" with - | None -> None - | Some toolNameProperty -> - match ReflectionHelper.getInstanceProperty theType Array.empty "Key" with - | None -> None - | Some keyProperty -> - match ReflectionHelper.getInstanceMethod theType [|typeof;typeof;typeof;typeof;|] "ResolveDependencies" with - | None -> None - | Some resolveDependenciesMethod -> - Some (fun () -> new ReflectionDependencyManagerProvider(theType, nameProperty, toolNameProperty, keyProperty, resolveDependenciesMethod) :> IDependencyManagerProvider) + else + match ReflectionHelper.getAttributeNamed theType "FSharpDependencyManagerAttribute" with + | None -> None + | Some _ -> + match ReflectionHelper.getInstanceProperty theType Array.empty "Name", + ReflectionHelper.getInstanceProperty theType Array.empty "ToolName", + ReflectionHelper.getInstanceProperty theType Array.empty "Key", + ReflectionHelper.getInstanceMethod theType [|typeof;typeof;typeof;typeof;|] "ResolveDependencies" + with + | Some nameProperty, Some toolNameProperty, Some keyProperty, Some resolveDependenciesMethod -> + Some (fun () -> new ReflectionDependencyManagerProvider(theType, nameProperty, toolNameProperty, keyProperty, resolveDependenciesMethod) :> IDependencyManagerProvider) + | _ -> None interface IDependencyManagerProvider with member __.Name = instance |> nameProperty @@ -104,29 +103,34 @@ type ReflectionDependencyManagerProvider(theType: Type, nameProperty: PropertyIn member __.ResolveDependencies(targetFramework, scriptDir, scriptName, packageManagerTextLines) = let arguments = [|box targetFramework; box scriptDir; box scriptName; box packageManagerTextLines|] resolveDeps.Invoke(instance, arguments) :?> _ + interface IDisposable with member __.Dispose () = instance.Dispose() - -let assemblySearchPaths = - lazy( - [let assemblyLocation = typeof.Assembly.Location - yield Path.GetDirectoryName assemblyLocation + +let assemblySearchLocations (additionalIncludePaths:string list) = + additionalIncludePaths @ + [ + yield Path.GetDirectoryName typeof.Assembly.Location #if FX_NO_APP_DOMAINS - yield AppContext.BaseDirectory + yield AppContext.BaseDirectory #else - yield AppDomain.CurrentDomain.BaseDirectory + yield AppDomain.CurrentDomain.BaseDirectory #endif - ] - |> List.distinct - ) - -let enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation () = - assemblySearchPaths.Force() + ] |> List.distinct + +let enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation (additionalIncludePaths:string list) = + /// Where to search for providers + /// Algorithm TBD + /// 1. Directory containing FSharp.Compiler.dll + /// 2. AppContext (AppDomain on desktop) Base directory + /// 3. directories supplied using --lib + (assemblySearchLocations additionalIncludePaths) |> Seq.collect (fun path -> Directory.EnumerateFiles(path,"*DependencyManager*.dll")) |> Seq.choose (fun path -> try Assembly.LoadFrom path |> Some with | _ -> None) - |> Seq.filter (fun a -> ReflectionHelper.assemblyHasAttribute a "FSharpDependencyManagerAttribute") + |> Seq.filter (fun a -> ReflectionHelper.assemblyHasAttributeNamed a "FSharpDependencyManagerAttribute") +/// TBD type ProjectDependencyManager() = interface IDependencyManagerProvider with member __.Name = "Project loader" @@ -138,9 +142,10 @@ type ProjectDependencyManager() = interface System.IDisposable with member __.Dispose() = () +/// Contract for DependencyManager for #r assemblies type RefDependencyManager() = interface IDependencyManagerProvider with - member __.Name = "Ref library loader" + member __.Name = "Library loader" member __.ToolName = "" member __.Key = "ref" member __.ResolveDependencies(_targetFramework:string, _scriptDir: string, _scriptName: string, _packageManagerTextLines: string seq) = @@ -149,54 +154,47 @@ type RefDependencyManager() = interface System.IDisposable with member __.Dispose() = () -type ImplDependencyManager() = - interface IDependencyManagerProvider with - member __.Name = "Impl library loader" - member __.ToolName = "" - member __.Key = "impl" - member __.ResolveDependencies(_targetFramework:string, _scriptDir: string, _scriptName: string, _packageManagerTextLines: string seq) = - None,[] - - interface System.IDisposable with - member __.Dispose() = () - -let registeredDependencyManagers = lazy ( - let defaultProviders = - [new ProjectDependencyManager() :> IDependencyManagerProvider - new RefDependencyManager() :> IDependencyManagerProvider - new ImplDependencyManager() :> IDependencyManagerProvider] - - let loadedProviders = - enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation() - |> Seq.collect (fun a -> a.GetTypes()) - |> Seq.choose ReflectionDependencyManagerProvider.InstanceMaker - |> Seq.map (fun maker -> maker ()) - - defaultProviders - |> Seq.append loadedProviders - |> Seq.map (fun pm -> pm.Key, pm) - |> Map.ofSeq -) - -let RegisteredDependencyManagers() = registeredDependencyManagers.Force() - -let createPackageManagerUnknownError packageManagerKey m = - let registeredKeys = String.Join(", ", RegisteredDependencyManagers() |> Seq.map (fun kv -> kv.Value.Key)) - let searchPaths = assemblySearchPaths.Force() +/// Get the list of registered DependencyManagers +let registeredDependencyManagers (additionalIncludePaths: string list) = + let dependencyManagers = + lazy ( + let defaultProviders = + [new ProjectDependencyManager() :> IDependencyManagerProvider + new RefDependencyManager() :> IDependencyManagerProvider ] + + let loadedProviders = + enumerateDependencyManagerAssembliesFromCurrentAssemblyLocation(additionalIncludePaths) + |> Seq.collect (fun a -> a.GetTypes()) + |> Seq.choose ReflectionDependencyManagerProvider.InstanceMaker + |> Seq.map (fun maker -> maker ()) + + defaultProviders + |> Seq.append loadedProviders + |> Seq.map (fun pm -> pm.Key, pm) + |> Map.ofSeq + ) + dependencyManagers.Force() + +/// Issue PackageManner error +let createPackageManagerUnknownError packageManagerKey m (additionalIncludePaths: string list) = + let registeredKeys = String.Join(", ", registeredDependencyManagers(additionalIncludePaths) |> Seq.map (fun kv -> kv.Value.Key)) + let searchPaths = assemblySearchLocations additionalIncludePaths Error(FSComp.SR.packageManagerUnknown(packageManagerKey, String.Join(", ", searchPaths), registeredKeys),m) -let tryFindDependencyManagerInPath m (path:string) : ReferenceType = +/// Issue Look for a packagemanager given a #r path. (Path may contain a package manager moniker 'nuget', 'paket' followed by ':' +/// or be a fully qualified Windows path 'C:...', a relative path or a UNC qualified path) +let tryFindDependencyManagerInPath m (path:string) (additionalIncludePaths: string list): ReferenceType = try match path.IndexOf(":") with | -1 | 1 -> ReferenceType.Library path | _ -> - let managers = RegisteredDependencyManagers() + let managers = registeredDependencyManagers(additionalIncludePaths) match managers |> Seq.tryFind (fun kv -> path.StartsWith(kv.Value.Key + ":" )) with | None -> - errorR(createPackageManagerUnknownError (path.Split(':').[0]) m) + errorR(createPackageManagerUnknownError (path.Split(':').[0]) m additionalIncludePaths) ReferenceType.UnknownType - | Some kv -> ReferenceType.RegisteredDependencyManager kv.Value + | Some kv -> (ReferenceType.RegisteredDependencyManager kv.Value) with | e -> errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) @@ -204,9 +202,9 @@ let tryFindDependencyManagerInPath m (path:string) : ReferenceType = let removeDependencyManagerKey (packageManagerKey:string) (path:string) = path.Substring(packageManagerKey.Length + 1).Trim() -let tryFindDependencyManagerByKey m (key:string) : IDependencyManagerProvider option = +let tryFindDependencyManagerByKey m (key:string) (additionalIncludePaths: string list): IDependencyManagerProvider option = try - RegisteredDependencyManagers() |> Map.tryFind key + registeredDependencyManagers(additionalIncludePaths) |> Map.tryFind key with | e -> errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) @@ -227,4 +225,4 @@ let resolve (packageManager:IDependencyManagerProvider) implicitIncludeDir fileN errorR(Error(FSComp.SR.packageManagerError(e.InnerException.Message),m)) else errorR(Error(FSComp.SR.packageManagerError(e.Message),m)) - None \ No newline at end of file + None diff --git a/src/fsharp/DependencyManager.Integration.fsi b/src/fsharp/DependencyManager.Integration.fsi index 3419a9e65f2..5e3df74a3d1 100644 --- a/src/fsharp/DependencyManager.Integration.fsi +++ b/src/fsharp/DependencyManager.Integration.fsi @@ -5,6 +5,8 @@ module internal Microsoft.FSharp.Compiler.DependencyManagerIntegration open Microsoft.FSharp.Compiler.Range +/// Contract for dependency anager provider. This is a loose contract for now, just to define the shape, +/// it is resolved through reflection (ReflectionDependencyManagerProvider) type IDependencyManagerProvider = inherit System.IDisposable abstract Name : string @@ -12,18 +14,16 @@ type IDependencyManagerProvider = abstract Key: string abstract ResolveDependencies : string * string * string * string seq -> string option * string list +/// Reference [] type ReferenceType = | RegisteredDependencyManager of IDependencyManagerProvider | Library of string | UnknownType -val RegisteredDependencyManagers : unit -> Map -val tryFindDependencyManagerInPath : range -> string -> ReferenceType -val tryFindDependencyManagerByKey : range -> string -> IDependencyManagerProvider option - +val registeredDependencyManagers : string list -> Map +val tryFindDependencyManagerInPath : range -> string -> string list -> ReferenceType +val tryFindDependencyManagerByKey : range -> string -> string list -> IDependencyManagerProvider option val removeDependencyManagerKey : string -> string -> string - -val createPackageManagerUnknownError : string -> range -> exn - +val createPackageManagerUnknownError : string -> range -> string list -> exn val resolve : IDependencyManagerProvider -> string -> string -> range -> string seq -> (string option * string list) option diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 67750ca4dbe..c9c70386f26 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1221,13 +1221,13 @@ type internal FsiDynamicCompiler member __.EvalDependencyManagerTextFragment (packageManager:DependencyManagerIntegration.IDependencyManagerProvider,m,path: string) = let path = DependencyManagerIntegration.removeDependencyManagerKey packageManager.Key path - + match tcConfigB.packageManagerLines |> Map.tryFind packageManager.Key with | Some lines -> tcConfigB.packageManagerLines <- Map.add packageManager.Key (lines @ [path,m]) tcConfigB.packageManagerLines | _ -> tcConfigB.packageManagerLines <- Map.add packageManager.Key [path,m] tcConfigB.packageManagerLines needsPackageResolution <- true - + member fsiDynamicCompiler.CommitDependencyManagerText (ctok, istate: FsiDynamicCompilerState, lexResourceManager, errorLogger) = if not needsPackageResolution then istate else needsPackageResolution <- false @@ -1239,9 +1239,9 @@ type internal FsiDynamicCompiler | [] -> () | (_,m)::_ -> let packageManagerTextLines = packageManagerLines |> List.map fst - match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey with + match DependencyManagerIntegration.tryFindDependencyManagerByKey m packageManagerKey tcConfigB.includes with | None -> - errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m) + errorR(DependencyManagerIntegration.createPackageManagerUnknownError packageManagerKey m tcConfigB.includes) | Some packageManager -> match DependencyManagerIntegration.resolve packageManager tcConfigB.implicitIncludeDir "stdin.fsx" m packageManagerTextLines with | None -> () // error already reported @@ -1916,7 +1916,7 @@ type internal FsiInteractionProcessor fsiDynamicCompiler.EvalSourceFiles (ctok, istate, m, sourceFiles, lexResourceManager, errorLogger),Completed None | IHash (ParsedHashDirective(("reference" | "r"),[path],m),_) -> - match DependencyManagerIntegration.tryFindDependencyManagerInPath m (path:string) with + match DependencyManagerIntegration.tryFindDependencyManagerInPath m path tcConfigB.includes with | DependencyManagerIntegration.ReferenceType.RegisteredDependencyManager packageManager -> fsiDynamicCompiler.EvalDependencyManagerTextFragment(packageManager,m,path) istate,Completed None