Add support for --pathmap

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

@@ -93,6 +93,12 @@
     <Compile Include="$(FSharpSourcesRoot)/utils/prim-parsing.fs">
       <Link>LexYaccRuntime/prim-parsing.fs</Link>
     </Compile>
+    <Compile Include="$(FSharpSourcesRoot)/utils/PathMap.fsi">
+      <Link>Utilities/PathMap.fsi</Link>
+    </Compile>
+    <Compile Include="$(FSharpSourcesRoot)/utils/PathMap.fs">
+      <Link>Utilities/PathMap.fs</Link>
+    </Compile>
     <Compile Include="$(FSharpSourcesRoot)/utils/ResizeArray.fsi">
       <Link>Utilities/ResizeArray.fsi</Link>
     </Compile>

src/absil/ilwrite.fs

@@ -3515,8 +3515,8 @@ let writeDirectory os dict =
 let writeBytes (os: BinaryWriter) (chunk: byte[]) = os.Write(chunk, 0, chunk.Length)  
 
 let writeBinaryAndReportMappings (outfile, 
-                                  ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, 
-                                  embedAllSource, embedSourceList, sourceLink, emitTailcalls, deterministic, showTimes, dumpDebugInfo )
+                                  ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB,
+                                  embedAllSource, embedSourceList, sourceLink, emitTailcalls, deterministic, showTimes, dumpDebugInfo, pathMap)
                                   modul normalizeAssemblyRefs =
     // Store the public key from the signer into the manifest. This means it will be written 
     // to the binary and also acts as an indicator to leave space for delay sign 
@@ -3671,7 +3671,7 @@ let writeBinaryAndReportMappings (outfile,
             match portablePDB with
             | true -> 
                 let (uncompressedLength, contentId, stream) as pdbStream = 
-                    generatePortablePdb embedAllSource embedSourceList sourceLink showTimes pdbData deterministic
+                    generatePortablePdb embedAllSource embedSourceList sourceLink showTimes pdbData deterministic pathMap
 
                 if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream)
                 else Some pdbStream
@@ -4211,7 +4211,7 @@ let writeBinaryAndReportMappings (outfile,
                     if embeddedPDB then
                         embedPortablePdbInfo originalLength contentId stream showTimes fpdb debugDataChunk debugEmbeddedPdbChunk
                     else
-                        writePortablePdbInfo contentId stream showTimes fpdb debugDataChunk
+                        writePortablePdbInfo contentId stream showTimes fpdb pathMap debugDataChunk
                 | None ->
 #if FX_NO_PDB_WRITER
                     Array.empty<idd>
@@ -4284,10 +4284,11 @@ type options =
      emitTailcalls : bool
      deterministic : bool
      showTimes: bool
-     dumpDebugInfo: bool }
+     dumpDebugInfo: bool
+     pathMap: PathMap }
 
 let WriteILBinary (outfile, (args: options), modul, normalizeAssemblyRefs) =
     writeBinaryAndReportMappings (outfile, 
                                   args.ilg, args.pdbfile, args.signer, args.portablePDB, args.embeddedPDB, args.embedAllSource, 
-                                  args.embedSourceList, args.sourceLink, args.emitTailcalls, args.deterministic, args.showTimes, args.dumpDebugInfo) modul normalizeAssemblyRefs
+                                  args.embedSourceList, args.sourceLink, args.emitTailcalls, args.deterministic, args.showTimes, args.dumpDebugInfo, args.pathMap) modul normalizeAssemblyRefs
     |> ignore

src/absil/ilwrite.fsi

@@ -3,6 +3,7 @@
 /// The IL Binary writer.
 module internal FSharp.Compiler.AbstractIL.ILBinaryWriter 
 
+open Internal.Utilities
 open FSharp.Compiler.AbstractIL 
 open FSharp.Compiler.AbstractIL.Internal 
 open FSharp.Compiler.AbstractIL.IL 
@@ -27,7 +28,8 @@ type options =
    emitTailcalls: bool
    deterministic: bool
    showTimes : bool
-   dumpDebugInfo : bool }
+   dumpDebugInfo : bool
+   pathMap : PathMap }
 
 /// Write a binary to the file system. Extra configuration parameters can also be specified. 
 val WriteILBinary: filename: string * options:  options * input: ILModuleDef * (ILAssemblyRef -> ILAssemblyRef) -> unit

src/absil/ilwritepdb.fs

@@ -219,7 +219,7 @@ let getRowCounts tableRowCounts =
     tableRowCounts |> Seq.iter(fun x -> builder.Add x)
     builder.MoveToImmutable()
 
-let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (sourceLink: string) showTimes (info: PdbData) isDeterministic =
+let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (sourceLink: string) showTimes (info: PdbData) isDeterministic (pathMap: PathMap) =
     sortMethods showTimes info
     let externalRowCounts = getRowCounts info.TableRowCounts
     let docs = 
@@ -229,6 +229,7 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s
 
     let metadata = MetadataBuilder()
     let serializeDocumentName (name: string) =
+        let name = PathMap.apply pathMap name
         let count s c = s |> Seq.filter(fun ch -> if c = ch then true else false) |> Seq.length
 
         let s1, s2 = '/', '\\'
@@ -501,12 +502,12 @@ let compressPortablePdbStream (uncompressedLength: int64) (contentId: BlobConten
     stream.WriteTo compressionStream
     (uncompressedLength, contentId, compressedStream)
 
-let writePortablePdbInfo (contentId: BlobContentId) (stream: MemoryStream) showTimes fpdb cvChunk =
+let writePortablePdbInfo (contentId: BlobContentId) (stream: MemoryStream) showTimes fpdb pathMap cvChunk =
     try FileSystem.FileDelete fpdb with _ -> ()
     use pdbFile = new FileStream(fpdb, FileMode.Create, FileAccess.ReadWrite)
     stream.WriteTo pdbFile
     reportTime showTimes "PDB: Closed"
-    pdbGetDebugInfo (contentId.Guid.ToByteArray()) (int32 (contentId.Stamp)) fpdb cvChunk None 0L None
+    pdbGetDebugInfo (contentId.Guid.ToByteArray()) (int32 (contentId.Stamp)) (PathMap.apply pathMap fpdb) cvChunk None 0L None
 
 let embedPortablePdbInfo (uncompressedLength: int64)  (contentId: BlobContentId) (stream: MemoryStream) showTimes fpdb cvChunk pdbChunk =
     reportTime showTimes "PDB: Closed"

src/absil/ilwritepdb.fsi

@@ -3,6 +3,7 @@
 /// The ILPdbWriter 
 module internal FSharp.Compiler.AbstractIL.ILPdbWriter 
 
+open Internal.Utilities
 open FSharp.Compiler.AbstractIL.IL 
 open FSharp.Compiler.ErrorLogger
 open FSharp.Compiler.Range
@@ -82,10 +83,10 @@ type idd =
       iddData: byte[];
       iddChunk: BinaryChunk }
 
-val generatePortablePdb : embedAllSource:bool -> embedSourceList:string list -> sourceLink: string -> showTimes:bool -> info:PdbData -> isDeterministic:bool -> (int64 * BlobContentId * MemoryStream)
+val generatePortablePdb : embedAllSource:bool -> embedSourceList:string list -> sourceLink: string -> showTimes:bool -> info:PdbData -> isDeterministic:bool -> pathMap:PathMap -> (int64 * BlobContentId * MemoryStream)
 val compressPortablePdbStream : uncompressedLength:int64 -> contentId:BlobContentId -> stream:MemoryStream -> (int64 * BlobContentId * MemoryStream)
 val embedPortablePdbInfo : uncompressedLength:int64 -> contentId:BlobContentId -> stream:MemoryStream -> showTimes:bool -> fpdb:string -> cvChunk:BinaryChunk -> pdbChunk:BinaryChunk -> idd[]
-val writePortablePdbInfo : contentId:BlobContentId -> stream:MemoryStream -> showTimes:bool -> fpdb:string -> cvChunk:BinaryChunk -> idd[]
+val writePortablePdbInfo : contentId:BlobContentId -> stream:MemoryStream -> showTimes:bool -> fpdb:string -> pathMap:PathMap -> cvChunk:BinaryChunk -> idd[]
 
 #if !FX_NO_PDB_WRITER
 val writePdbInfo : showTimes:bool -> f:string -> fpdb:string -> info:PdbData -> cvChunk:BinaryChunk -> idd[]

src/fsharp/CompileOps.fs

@@ -2150,6 +2150,8 @@ type TcConfigBuilder =
       mutable internalTestSpanStackReferring: bool
 
       mutable noConditionalErasure: bool
+
+      mutable pathMap: PathMap
       }
 
     static member Initial =
@@ -2285,6 +2287,7 @@ type TcConfigBuilder =
           tryGetMetadataSnapshot = (fun _ -> None)
           internalTestSpanStackReferring = false
           noConditionalErasure = false
+          pathMap = PathMap.empty
         }
 
     static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir,
@@ -2408,6 +2411,9 @@ type TcConfigBuilder =
 
     member tcConfigB.RemoveReferencedAssemblyByPath (m, path) =
         tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs |> List.filter (fun ar -> not (Range.equals ar.Range m) || ar.Text <> path)
+
+    member tcConfigB.AddPathMapping (oldPrefix, newPrefix) =
+        tcConfigB.pathMap <- tcConfigB.pathMap |> PathMap.addMapping oldPrefix newPrefix
 
     static member SplitCommandLineResourceInfo (ri: string) =
         let p = ri.IndexOf ','
@@ -2730,6 +2736,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member x.optSettings = data.optSettings
     member x.emitTailcalls = data.emitTailcalls
     member x.deterministic = data.deterministic
+    member x.pathMap = data.pathMap
     member x.preferredUiLang = data.preferredUiLang
     member x.lcid = data.lcid
     member x.optsOn = data.optsOn
@@ -3407,7 +3414,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp
     try 
         let skip = true in (* don't report whitespace from lexer *)
         let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus filename, true) 
-        let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, ref [], errorLogger)
+        let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, ref [], errorLogger, tcConfig.pathMap)
         let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir 
         let input = 
             Lexhelp.usingLexbufForParsing (lexbuf, filename) (fun lexbuf ->
@@ -3607,7 +3614,9 @@ let MakeILResource rname bytes =
       CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
       MetadataIndex = NoMetadataIdx }
 
-let PickleToResource inMem file g scope rname p x = 
+let PickleToResource inMem file (g: TcGlobals) scope rname p x =
+    let file = PathMap.apply g.pathMap file
+
     { Name = rname
       Location = (let bytes = pickleObjWithDanglingCcus inMem file g scope p x in ILResourceLocation.LocalOut bytes)
       Access = ILResourceAccess.Public
@@ -3617,15 +3626,23 @@ let PickleToResource inMem file g scope rname p x =
 let GetSignatureData (file, ilScopeRef, ilModule, byteReader) : PickledDataWithReferences<PickledCcuInfo> = 
     unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo (byteReader())
 
-let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: CcuThunk, file, inMem) : ILResource = 
+let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: CcuThunk, file, inMem) : ILResource =
     let mspec = ccu.Contents
     let mspec = ApplyExportRemappingToEntity tcGlobals exportRemapping mspec
     // For historical reasons, we use a different resource name for FSharp.Core, so older F# compilers 
     // don't complain when they see the resource.
-    let rname = if ccu.AssemblyName = getFSharpCoreLibraryName then FSharpSignatureDataResourceName2 else FSharpSignatureDataResourceName 
+    let rname = if ccu.AssemblyName = getFSharpCoreLibraryName then FSharpSignatureDataResourceName2 else FSharpSignatureDataResourceName
+
+    let includeDir =
+        if String.IsNullOrEmpty tcConfig.implicitIncludeDir then ""
+        else
+            tcConfig.implicitIncludeDir
+            |> System.IO.Path.GetFullPath
+            |> PathMap.applyDir tcGlobals.pathMap
+
     PickleToResource inMem file tcGlobals ccu (rname+ccu.AssemblyName) pickleCcuInfo 
         { mspec=mspec 
-          compileTimeWorkingDir=tcConfig.implicitIncludeDir
+          compileTimeWorkingDir=includeDir
           usesQuotations = ccu.UsesFSharp20PlusQuotations }
 
 let GetOptimizationData (file, ilScopeRef, ilModule, byteReader) = 
@@ -4626,8 +4643,9 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu
 
         // OK, now we have both mscorlib.dll and FSharp.Core.dll we can create TcGlobals
         let tcGlobals = TcGlobals(tcConfig.compilingFslib, ilGlobals, fslibCcu, 
-                                    tcConfig.implicitIncludeDir, tcConfig.mlCompatibility, 
-                                    tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, tcConfig.noDebugData )
+                                    tcConfig.implicitIncludeDir, tcConfig.mlCompatibility,
+                                    tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations,
+                                    tcConfig.noDebugData, tcConfig.pathMap)
 
 #if DEBUG
         // the global_g reference cell is used only for debug printing

src/fsharp/CompileOps.fsi

@@ -6,6 +6,7 @@ module internal FSharp.Compiler.CompileOps
 open System
 open System.Text
 open System.Collections.Generic
+open Internal.Utilities
 open FSharp.Compiler.AbstractIL
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AbstractIL.ILBinaryReader
@@ -373,6 +374,7 @@ type TcConfigBuilder =
       /// Prevent erasure of conditional attributes and methods so tooling is able analyse them.
       mutable noConditionalErasure: bool
 
+      mutable pathMap : PathMap
     }
 
     static member Initial: TcConfigBuilder
@@ -396,7 +398,8 @@ type TcConfigBuilder =
     member RemoveReferencedAssemblyByPath: range * string -> unit
     member AddEmbeddedSourceFile: string -> unit
     member AddEmbeddedResource: string -> unit
-
+    member AddPathMapping: oldPrefix: string * newPrefix: string -> unit
+
     static member SplitCommandLineResourceInfo: string -> string * string * ILResourceAccess
 
 [<Sealed>]
@@ -496,6 +499,7 @@ type TcConfig =
     member optSettings  : Optimizer.OptimizationSettings 
     member emitTailcalls: bool
     member deterministic: bool
+    member pathMap: PathMap
     member preferredUiLang: string option
     member optsOn       : bool 
     member productNameForBannerText: string

src/fsharp/CompileOptions.fs

@@ -407,6 +407,13 @@ let SetTailcallSwitch (tcConfigB: TcConfigBuilder) switch =
 let SetDeterministicSwitch (tcConfigB: TcConfigBuilder) switch =
     tcConfigB.deterministic <- (switch = OptionSwitch.On)
 
+let AddPathMapping (tcConfigB: TcConfigBuilder) (pathPair: string) =
+    match pathPair.Split([|'='|], 2) with
+    | [| oldPrefix; newPrefix |] ->
+        tcConfigB.AddPathMapping (oldPrefix, newPrefix)
+    | _ ->
+        error(Error(FSComp.SR.optsInvalidPathMapFormat(), rangeCmdArgs))
+
 let jitoptimizeSwitch (tcConfigB: TcConfigBuilder) switch =
     tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some (switch = OptionSwitch.On) }
 
@@ -516,6 +523,7 @@ let tagWarnList = "<warn;...>"
 let tagSymbolList = "<symbol;...>"
 let tagAddress = "<address>"
 let tagInt = "<n>"
+let tagPathMap = "<path=sourcePath;...>"
 let tagNone = ""
 
 // PrintOptionInfo
@@ -786,7 +794,12 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) =
            ("deterministic", tagNone,
             OptionSwitch (SetDeterministicSwitch tcConfigB), None,
             Some (FSComp.SR.optsDeterministic()))
-
+
+          CompilerOption
+           ("pathmap", tagPathMap,
+            OptionStringList (AddPathMapping tcConfigB), None,
+            Some (FSComp.SR.optsPathMap()))
+
           CompilerOption
            ("crossoptimize", tagNone,
             OptionSwitch (crossOptimizeSwitch tcConfigB), None,

src/fsharp/FSComp.txt

@@ -860,6 +860,7 @@ optsDebug,"Specify debugging type: full, portable, embedded, pdbonly. ('%s' is t
 optsOptimize,"Enable optimizations (Short form: -O)"
 optsTailcalls,"Enable or disable tailcalls"
 optsDeterministic,"Produce a deterministic assembly (including module version GUID and timestamp)"
+optsPathMap,"Maps physical paths to source path names output by the compiler"
 optsCrossoptimize,"Enable or disable cross-module optimizations"
 optsWarnaserrorPM,"Report all warnings as errors"
 optsWarnaserror,"Report specific warnings as errors"
@@ -1140,7 +1141,9 @@ fscTooManyErrors,"Exiting - too many errors"
 2023,fscResxSourceFileDeprecated,"Passing a .resx file (%s) as a source file to the compiler is deprecated. Use resgen.exe to transform the .resx file into a .resources file to pass as a --resource option. If you are using MSBuild, this can be done via an <EmbeddedResource> item in the .fsproj project file."
 2024,fscStaticLinkingNoProfileMismatches,"Static linking may not be used on an assembly referencing mscorlib (e.g. a .NET Framework assembly) when generating an assembly that references System.Runtime (e.g. a .NET Core or Portable assembly)."
 2025,fscAssemblyWildcardAndDeterminism,"An %s specified version '%s', but this value is a wildcard, and you have requested a deterministic build, these are in conflict."
-2026,fscDeterministicDebugRequiresPortablePdb,"Determinstic builds only support portable PDBs (--debug:portable or --debug:embedded)"
+2026,fscDeterministicDebugRequiresPortablePdb,"Deterministic builds only support portable PDBs (--debug:portable or --debug:embedded)"
+2027,fscPathMapDebugRequiresPortablePdb,"--pathmap can only be used with portable PDBs (--debug:portable or --debug:embedded)"
+2028,optsInvalidPathMapFormat,"Invalid path map. Mappings must be comma separated and of the format 'path=sourcePath'"
 3000,etIllegalCharactersInNamespaceName,"Character '%s' is not allowed in provided namespace name '%s'"
 3001,etNullOrEmptyMemberName,"The provided type '%s' returned a member with a null or empty member name"
 3002,etNullMember,"The provided type '%s' returned a null member"

src/fsharp/FSharp.Build/Fsc.fs

@@ -41,7 +41,8 @@ type public Fsc () as this =
     let mutable noFramework = false
     let mutable optimize  : bool = true
     let mutable otherFlags : string = null
-    let mutable outputAssembly : string = null 
+    let mutable outputAssembly : string = null
+    let mutable pathMap : string = null
     let mutable pdbFile : string = null
     let mutable platform : string = null
     let mutable prefer32bit : bool = false
@@ -233,6 +234,10 @@ type public Fsc () as this =
         builder.AppendSwitchIfNotNull("--targetprofile:", targetProfile)
 
         builder.AppendSwitch("--nocopyfsharpcore")
+
+        match pathMap with
+        | null -> ()
+        | _ -> builder.AppendSwitchIfNotNull("--pathmap:", pathMap.Split([|';'; ','|], StringSplitOptions.RemoveEmptyEntries), ",")
 
         // OtherFlags - must be second-to-last
         builder.AppendSwitchUnquotedIfNotNull("", otherFlags)
@@ -346,6 +351,11 @@ type public Fsc () as this =
         with get() = outputAssembly
         and set(s) = outputAssembly <- s
 
+    // --pathmap <string>: Paths to rewrite when producing deterministic builds
+    member fsc.PathMap
+        with get() = pathMap
+        and set(s) = pathMap <- s
+
     // --pdb <string>: 
     //     Name the debug output file
     member fsc.PdbFile

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

@@ -294,6 +294,7 @@ this file.
               Optimize="$(Optimize)"
               OtherFlags="$(FscOtherFlags)"
               OutputAssembly="@(IntermediateAssembly)"
+              PathMap="$(PathMap)"
               PdbFile="$(PdbFile)"
               Platform="$(PlatformTarget)"
               Prefer32Bit="$(Actual32Bit)"

src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj

@@ -174,6 +174,12 @@
     <Compile Include="..\rational.fs">
       <Link>Utilities\rational.fs</Link>
     </Compile>
+    <Compile Include="..\..\utils\PathMap.fsi">
+      <Link>Utilities\PathMap.fsi</Link>
+    </Compile>
+    <Compile Include="..\..\utils\PathMap.fs">
+      <Link>Utilities\PathMap.fs</Link>
+    </Compile>
     <Compile Include="..\range.fsi">
       <Link>ErrorLogging\range.fsi</Link>
     </Compile>

src/fsharp/TastPickle.fs

@@ -1315,7 +1315,11 @@ let u_qlist uv = u_wrap QueueList.ofList (u_list uv)
 let u_namemap u = u_Map u_string u
 
 let p_pos (x: pos) st = p_tup2 p_int p_int (x.Line, x.Column) st
-let p_range (x: range) st = p_tup3 p_string p_pos p_pos (x.FileName, x.Start, x.End) st
+
+let p_range (x: range) st =
+    let fileName = PathMap.apply st.oglobals.pathMap x.FileName
+    p_tup3 p_string p_pos p_pos (fileName, x.Start, x.End) st
+
 let p_dummy_range : range pickler   = fun _x _st -> ()
 let p_ident (x: Ident) st = p_tup2 p_string p_range (x.idText, x.idRange) st
 let p_xmldoc (XmlDoc x) st = p_array p_string x st