fshappowerpack /compiler/3.1/Nov2013/src/fsharp/ReferenceResolution.fs

Language F# Lines 443
MD5 Hash 767d3f392236958b4dcc32c5fc43fb6b
Repository https://fshappowerpack.svn.codeplex.com/svn View Raw File
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
namespace Viz

/// This type exists to have a concrete 'Target' type for a DebuggerVisualizerAttribute.
/// Ideally it would be out in its own assembly, but then the compiler would need to take a dependency on that assembly, so instead we 
/// pragmatically just shove this into the compiler assembly itself.
type internal Visualizable(o:obj) =
    member this.Data = o
    /// assuming this assembly is already in the debuggee process, then Viz.Visualiable.Make(foo) in the Watch window will make a visualizer for foo
    static member Make(o:obj) = new Visualizable(o)

namespace Microsoft.FSharp.Compiler

module internal MSBuildResolver = 

    open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library 
    exception ResolutionFailure
    
    type ResolvedFrom =
        | AssemblyFolders
        | AssemblyFoldersEx
        | TargetFrameworkDirectory
        | RawFileName
        | GlobalAssemblyCache
        | Path of string
        | Unknown
            
    type ResolutionEnvironment = CompileTimeLike | RuntimeLike | DesigntimeLike
    
#if SILVERLIGHT
#else
    open System
    open Microsoft.Build.Tasks
    open Microsoft.Build.Utilities
    open Microsoft.Build.Framework
    open Microsoft.Build.BuildEngine
    open System.IO

    type ResolvedFile = {
            itemSpec:string
            resolvedFrom:ResolvedFrom
            fusionName:string
            version:string
            redist:string        
            baggage:string
        }
        with override this.ToString() = sprintf "ResolvedFile(%s)" this.itemSpec
    
    type ResolutionResults = {
        resolvedFiles:ResolvedFile array
        referenceDependencyPaths:string array
        relatedPaths:string array
        referenceSatellitePaths:string array
        referenceScatterPaths:string array
        referenceCopyLocalPaths:string array
        suggestedBindingRedirects:string array
        }

    let DotNetFrameworkReferenceAssembliesRootDirectory = 
        // Note that ProgramFilesX86 is correct for both x86 and x64 architectures (the reference assemblies are always in the 32-bit location, which is PF(x86) on an x64 machine)
        let PF = 
            //System.Environment.GetFolderPath(System.Environment.SpecialFolder.ProgramFilesX86) // This API is not available to bootstrap compiler
            match System.Environment.GetEnvironmentVariable("ProgramFiles(x86)") with
            | null -> System.Environment.GetEnvironmentVariable("ProgramFiles")  // if PFx86 is null, then we are 32-bit and just get PF
            | s -> s 
        PF + @"\Reference Assemblies\Microsoft\Framework\.NETFramework"


    let ReplaceFrameworkVariables(dirs) =
        let windowsFramework = System.Environment.GetEnvironmentVariable("windir")+ @"\Microsoft.NET\Framework"
        let referenceAssemblies = DotNetFrameworkReferenceAssembliesRootDirectory
        dirs|>List.map(fun (d:string)->d.Replace("{WindowsFramework}",windowsFramework).Replace("{ReferenceAssemblies}",referenceAssemblies))

    
    // ATTENTION!: the following code needs to be updated every time we are switching to the new MSBuild version because new .NET framework version was released
    // 1. List of frameworks
    // 2. DeriveTargetFrameworkDirectoriesFor45Plus
    // 3. HighestInstalledNetFrameworkVersionMajorMinor
    // 4. GetPathToDotNetFramework
    [<Literal>]    
    let private Net10 = "v1.0"
    [<Literal>]    
    let private Net11 = "v1.1"
    [<Literal>]    
    let private Net20 = "v2.0"
    [<Literal>]    
    let private Net30 = "v3.0"
    [<Literal>]    
    let private Net35 = "v3.5"
    [<Literal>]    
    let private Net40 = "v4.0"
    [<Literal>]    
    let private Net45 = "v4.5"
    [<Literal>]    
    let private Net451 = "v4.5.1"

    let SupportedNetFrameworkVersions = set [ Net20; Net30; Net35; Net40; Net45; Net451; (*SL only*) "v5.0" ]
    
    let GetPathToDotNetFramework(v) =
#if FX_ATLEAST_45
        let v =
            match v with
            | Net11 ->  Some TargetDotNetFrameworkVersion.Version11
            | Net20 ->  Some TargetDotNetFrameworkVersion.Version20
            | Net30 ->  Some TargetDotNetFrameworkVersion.Version30
            | Net35 ->  Some TargetDotNetFrameworkVersion.Version35
            | Net40 ->  Some TargetDotNetFrameworkVersion.Version40
            | Net45 ->  Some TargetDotNetFrameworkVersion.Version45
            | Net451 -> Some TargetDotNetFrameworkVersion.Version451
            | _ -> assert false; None
        match v with
        | Some v -> 
            match ToolLocationHelper.GetPathToDotNetFramework v with
            | null -> []
            | x -> [x]
        | _ -> []
#else
        // FX_ATLEAST_45 is not defined is required for step when we build compiler with proto compiler and this branch should not be hit
        // assert false
        []
#endif        

    let DeriveTargetFrameworkDirectoriesFor40Plus(version) = 
#if FX_ATLEAST_45
        // starting with .Net 4.0, the runtime dirs (WindowsFramework) are never used by MSBuild RAR
        let v =
            match version with
            | Net40 -> Some TargetDotNetFrameworkVersion.Version40
            | Net45 -> Some TargetDotNetFrameworkVersion.Version45
            | Net451 -> Some TargetDotNetFrameworkVersion.Version451
            | _ -> assert false; None // unknown version - some parts in the code are not synced
        match v with
        | Some v -> 
            match ToolLocationHelper.GetPathToDotNetFrameworkReferenceAssemblies v with
            | null -> []
            | x -> [x]
        | None -> []        
#else
        // FX_ATLEAST_45 is not defined is required for step when we build compiler with proto compiler and this branch should not be hit
        //assert false
        []
#endif

    /// Determine the default "frameworkVersion" (which is passed into MSBuild resolve).
    /// This code uses MSBuild to determine version of the highest installed framework.
    let HighestInstalledNetFrameworkVersionMajorMinor() =
#if FX_ATLEAST_45    
        if box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version451)) <> null then 4, Net451
        elif box (ToolLocationHelper.GetPathToDotNetFramework(TargetDotNetFrameworkVersion.Version45)) <> null then 4, Net45
        else 4, Net40 // version is 4.0 assumed since this code is running.
#else
        // FX_ATLEAST_45 is not defined is required for step when we build compiler with proto compiler and this branch should not be hit
        4, Net40
#endif

    /// Derive the target framework directories.        
    let DeriveTargetFrameworkDirectories
                (targetFrameworkVersion:string,             // e.g. v2.0, v3.0, v3.5, v4.0 etc                 
                 logmessage:string->unit) =
        let targetFrameworkVersion =
            if not(targetFrameworkVersion.StartsWith("v",StringComparison.Ordinal)) then "v"^targetFrameworkVersion
            else targetFrameworkVersion
        let FrameworkStartsWith(short) =
            targetFrameworkVersion.StartsWith(short,StringComparison.Ordinal)
        let result =
            if FrameworkStartsWith(Net10) then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.0.3705"])
            else if FrameworkStartsWith(Net11) then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.1.4322"])
            else if FrameworkStartsWith(Net20) then ReplaceFrameworkVariables([@"{WindowsFramework}\v2.0.50727"])
            else if FrameworkStartsWith(Net30) then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.0"; @"{WindowsFramework}\v3.0"; @"{WindowsFramework}\v2.0.50727"])
            else if FrameworkStartsWith(Net35) then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.5"; @"{WindowsFramework}\v3.5"; @"{ReferenceAssemblies}\v3.0"; @"{WindowsFramework}\v3.0"; @"{WindowsFramework}\v2.0.50727"])
            else DeriveTargetFrameworkDirectoriesFor40Plus(targetFrameworkVersion)

        let result = result |> Array.ofList                
        logmessage (sprintf "Derived target framework directories for version %s are: %s" targetFrameworkVersion (String.Join(",", result)))                
        result    
 
    /// Decode the ResolvedFrom code from MSBuild.
    let DecodeResolvedFrom(resolvedFrom:string) : ResolvedFrom = 
        let Same a b = 
            String.CompareOrdinal(a,b) = 0            
        match resolvedFrom with
        | r when Same "{RawFileName}" r -> RawFileName
        | r when Same "{GAC}" r -> GlobalAssemblyCache
        | r when Same "{TargetFrameworkDirectory}" r -> TargetFrameworkDirectory
        | r when Same "{AssemblyFolders}" r -> AssemblyFolders
        | r when r.Length >= 10 && Same "{Registry:" (r.Substring(0,10)) -> AssemblyFoldersEx
        | r -> ResolvedFrom.Path r
        

    type ErrorWarningCallbackSig = ((*code:*)string->(*message*)string->unit)
                      
    type Foregrounded =
        | ForegroundedMessage of string 
        | ForegroundedError of string * string
        | ForegroundedWarning of string * string

    let ResolveCore(
                    resolutionEnvironment: ResolutionEnvironment,
                    references:(string*(*baggage*)string)[], 
                    targetFrameworkVersion:string, 
                    targetFrameworkDirectories:string list,
                    targetProcessorArchitecture:string,                
                    outputDirectory:string, 
                    fsharpCoreExplicitDirOrFSharpBinariesDir:string,
                    explicitIncludeDirs:string list,
                    implicitIncludeDir:string,
                    frameworkRegistryBase:string, 
                    assemblyFoldersSuffix:string, 
                    assemblyFoldersConditions:string, 
                    allowRawFileName:bool,
                    logmessage:string->unit, 
                    logwarning:ErrorWarningCallbackSig, 
                    logerror:ErrorWarningCallbackSig ) =

        // Message Foregrounding:
        //   In version 4.0 MSBuild began calling log methods on a background (non-UI) thread. If there is an exception thrown from 
        //   logmessage, logwarning or logerror then it would kill the process.
        //   The fix is to catch these exceptions and log the rest of the messages to a list to output at the end.
        //   It looks simpler to always just accumulate the messages during resolution and show them all at the end, but then 
        //   we couldn't see the messages as resolution progresses.
        let foregrounded = ref []                
        let backgroundException : exn option ref = ref None
        
        let logmessage message = 
            match !backgroundException with
            | Some _ -> foregrounded := ForegroundedMessage(message) :: !foregrounded
            | None -> 
                try 
                    logmessage message
                with e ->
                    backgroundException := Some(e)
                    foregrounded := ForegroundedMessage(message) :: !foregrounded
                
        let logwarning code message = 
            match !backgroundException with
            | Some _ -> foregrounded := ForegroundedWarning(code,message) :: !foregrounded
            | None -> 
                try 
                    logwarning code message
                with e ->
                    backgroundException := Some(e)     
                    foregrounded := ForegroundedWarning(code,message) :: !foregrounded      
                    
        let logerror code message = 
            match !backgroundException with
            | Some _ -> foregrounded := ForegroundedError(code,message) :: !foregrounded
            | None -> 
                try 
                    logerror code message
                with e ->
                    backgroundException := Some(e)     
                    foregrounded := ForegroundedError(code,message) :: !foregrounded                             
                
                
        let engine = { new IBuildEngine with 
                    member be.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true
                    member be.LogCustomEvent(e) = logmessage e.Message
                    member be.LogErrorEvent(e) = logerror e.Code e.Message
                    member be.LogMessageEvent(e) = logmessage e.Message
                    member be.LogWarningEvent(e) = logwarning e.Code e.Message
                    member be.ColumnNumberOfTaskNode with get() = 1
                    member be.LineNumberOfTaskNode with get() = 1
                    member be.ContinueOnError with get() = true
                    member be.ProjectFileOfTaskNode with get() = "" }
                    
        let rar = new ResolveAssemblyReference()
        rar.BuildEngine <- engine
        
        // Derive target framework directory if none was supplied.
        let targetFrameworkDirectories =
            if targetFrameworkDirectories=[] then DeriveTargetFrameworkDirectories(targetFrameworkVersion, logmessage) 
            else targetFrameworkDirectories |> Array.ofList
            
        // Filter for null and zero length, and escape backslashes so legitimate path characters aren't mistaken for
        // escape characters (E.g., ".\r.dll")            
        let explicitIncludeDirs = explicitIncludeDirs |> List.filter(fun eid->not(String.IsNullOrEmpty(eid)))
        let references = references |> Array.filter(fun (path,_)->not(String.IsNullOrEmpty(path))) // |> Array.map (fun (path,baggage) -> (path.Replace("\\","\\\\"),baggage))
       
        rar.TargetFrameworkDirectories <- targetFrameworkDirectories 
        rar.FindRelatedFiles <- false
        rar.FindDependencies <- false
        rar.FindSatellites <- false
        rar.FindSerializationAssemblies <- false
#if BUILDING_WITH_LKG
        ignore targetProcessorArchitecture
#else       
        rar.TargetedRuntimeVersion <- typeof<obj>.Assembly.ImageRuntimeVersion
        rar.TargetProcessorArchitecture <- targetProcessorArchitecture
        rar.CopyLocalDependenciesWhenParentReferenceInGac <- true
#endif        
        rar.Assemblies <- [|for (referenceName,baggage) in references -> 
                                        let item = new Microsoft.Build.Utilities.TaskItem(referenceName)
                                        item.SetMetadata("Baggage", baggage)
                                        item:>ITaskItem|]

        let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else []
        let searchPaths = 
            match resolutionEnvironment with
            | DesigntimeLike
            | RuntimeLike ->
                logmessage("Using scripting resolution precedence.")                      
                // These are search paths for runtime-like or scripting resolution. GAC searching is present.
                rawFileNamePath @        // Quick-resolve straight to filename first 
                explicitIncludeDirs @    // From -I, #I
                [implicitIncludeDir] @   // Usually the project directory
                [fsharpCoreExplicitDirOrFSharpBinariesDir] @    // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe
                ["{TargetFrameworkDirectory}"] @
                [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @
                ["{AssemblyFolders}"] @
                ["{GAC}"] 
            | CompileTimeLike -> 
                logmessage("Using compilation resolution precedence.")                      
                // These are search paths for compile-like resolution. GAC searching is not present.
                ["{TargetFrameworkDirectory}"] @
                rawFileNamePath @        // Quick-resolve straight to filename first
                explicitIncludeDirs @    // From -I, #I
                [implicitIncludeDir] @   // Usually the project directory
                [fsharpCoreExplicitDirOrFSharpBinariesDir] @    // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe
                [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ // Like {Registry:Software\Microsoft\.NETFramework,v2.0,AssemblyFoldersEx}
                ["{AssemblyFolders}"] @
                [outputDirectory] @
                ["{GAC}"] @
                GetPathToDotNetFramework targetFrameworkVersion // use path to implementation assemblies as the last resort
    
        rar.SearchPaths <- searchPaths |> Array.ofList
                                  
        rar.AllowedAssemblyExtensions <- [| ".dll" ; ".exe" |]     
        
        let succeeded = rar.Execute()
        
        // Unroll any foregrounded messages
        match !backgroundException with
        | Some(backGroundException) ->
            logwarning "" "Saw error on logger thread during resolution."
            logwarning "" (sprintf "%A" backGroundException)
            logwarning "" "Showing messages seen after exception."

            !foregrounded
            |> List.iter(fun message-> 
               match message with 
               | ForegroundedMessage(message) -> logmessage message
               | ForegroundedWarning(code,message) -> logwarning code message
               | ForegroundedError(code,message) -> logerror code message )
        | None -> ()            

        if not succeeded then 
            raise ResolutionFailure

        {
            resolvedFiles = [| for p in rar.ResolvedFiles -> {itemSpec = p.ItemSpec; 
                                                              resolvedFrom = DecodeResolvedFrom(p.GetMetadata("ResolvedFrom"));
                                                              fusionName = p.GetMetadata("FusionName"); 
                                                              version = p.GetMetadata("Version"); 
                                                              redist = p.GetMetadata("Redist"); 
                                                              baggage = p.GetMetadata("Baggage") } |]
            referenceDependencyPaths = [| for p in rar.ResolvedDependencyFiles -> p.ItemSpec |]
            relatedPaths = [| for p in rar.RelatedFiles -> p.ItemSpec |]
            referenceSatellitePaths = [| for p in rar.SatelliteFiles -> p.ItemSpec |]
            referenceScatterPaths = [| for p in rar.ScatterFiles -> p.ItemSpec |]
            referenceCopyLocalPaths = [| for p in rar.CopyLocalFiles -> p.ItemSpec |]
            suggestedBindingRedirects = [| for p in rar.SuggestedRedirects -> p.ItemSpec |]
        }

    let Resolve(
                resolutionEnvironment: ResolutionEnvironment,
                references:(string*(*baggage*)string)[], 
                targetFrameworkVersion:string, 
                targetFrameworkDirectories:string list,
                targetProcessorArchitecture:string,                
                outputDirectory:string, 
                fsharpCoreExplicitDirOrFSharpBinariesDir:string,
                explicitIncludeDirs:string list,
                implicitIncludeDir:string,
                frameworkRegistryBase:string, 
                assemblyFoldersSuffix:string, 
                assemblyFoldersConditions:string, 
                logmessage:string->unit, 
                logwarning:ErrorWarningCallbackSig, 
                logerror:ErrorWarningCallbackSig ) =
        // The {RawFileName} target is 'dangerous', in the sense that is uses Directory.GetCurrentDirectory() to resolve unrooted file paths.
        // It is unreliable to use this mutable global state inside Visual Studio.  As a result, we partition all references into a "rooted" set
        // (which contains e.g. C:\MyDir\MyAssem.dll) and "unrooted" (everything else).  We only allow "rooted" to use {RawFileName}.  Note that
        // unrooted may still find 'local' assemblies by virtue of the fact that "implicitIncludeDir" is one of the places searched during 
        // assembly resolution.
        let references = references |> Array.map (fun ((file,baggage) as data) -> 
            // However, MSBuild will not resolve 'relative' paths, even when e.g. implicitIncludeDir is part of the search.  As a result,
            // if we have an unrooted path+filename, we'll assume this is relative to the project directory and root it.
            if FileSystem.IsPathRootedShim(file) then
                data  // fine, e.g. "C:\Dir\foo.dll"
            elif not(file.Contains("\\") || file.Contains("/")) then
                data  // fine, e.g. "System.Transactions.dll"
            else
                // we have a 'relative path', e.g. "bin/Debug/foo.exe" or "..\Yadda\bar.dll"
                // turn it into an absolute path based at implicitIncludeDir
                (System.IO.Path.Combine(implicitIncludeDir, file), baggage)
        )
        let rooted, unrooted = references |> Array.partition (fun (file,_baggage) -> FileSystem.IsPathRootedShim(file))

        let CallResolveCore(references, allowRawFileName) =    
            if Array.isEmpty references then 
                {
                    resolvedFiles = [| |]
                    referenceDependencyPaths = [| |]
                    relatedPaths = [| |]
                    referenceSatellitePaths = [| |]
                    referenceScatterPaths = [| |]
                    referenceCopyLocalPaths = [| |]
                    suggestedBindingRedirects = [| |]
                }
            else
                // all the params are the same...
                ResolveCore(
                    resolutionEnvironment,
                    references, // ... except this
                    targetFrameworkVersion, 
                    targetFrameworkDirectories,
                    targetProcessorArchitecture,                
                    outputDirectory, 
                    fsharpCoreExplicitDirOrFSharpBinariesDir,
                    explicitIncludeDirs,
                    implicitIncludeDir,
                    frameworkRegistryBase, 
                    assemblyFoldersSuffix, 
                    assemblyFoldersConditions, 
                    allowRawFileName, // ... and this
                    logmessage, 
                    logwarning, 
                    logerror)

        let rootedResults = CallResolveCore(rooted, true)
        let unrootedResults = CallResolveCore(unrooted, false)
        // now unify the two sets of results
        {
            resolvedFiles = Array.concat [| rootedResults.resolvedFiles; unrootedResults.resolvedFiles |]
            referenceDependencyPaths = set rootedResults.referenceDependencyPaths |> Set.union (set unrootedResults.referenceDependencyPaths) |> Set.toArray 
            relatedPaths = set rootedResults.relatedPaths |> Set.union (set unrootedResults.relatedPaths) |> Set.toArray 
            referenceSatellitePaths = set rootedResults.referenceSatellitePaths |> Set.union (set unrootedResults.referenceSatellitePaths) |> Set.toArray 
            referenceScatterPaths = set rootedResults.referenceScatterPaths |> Set.union (set unrootedResults.referenceScatterPaths) |> Set.toArray 
            referenceCopyLocalPaths = set rootedResults.referenceCopyLocalPaths |> Set.union (set unrootedResults.referenceCopyLocalPaths) |> Set.toArray 
            suggestedBindingRedirects = set rootedResults.suggestedBindingRedirects |> Set.union (set unrootedResults.suggestedBindingRedirects) |> Set.toArray 
        }

#endif
Back to Top