diff --git a/src/absil/il.fs b/src/absil/il.fs old mode 100755 new mode 100644 diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 88b9965b72..62196b77a3 100755 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -3536,7 +3536,7 @@ let writeDirectory os dict = let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length) -let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, +let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, embedAllSource, embedSourceList, fixupOverlappingSequencePoints, emitTailcalls, showTimes, dumpDebugInfo) modul noDebugData = // 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 @@ -3690,7 +3690,7 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: let pdbOpt = match portablePDB with | true -> - let (uncompressedLength, contentId, stream) as pdbStream = generatePortablePdb fixupOverlappingSequencePoints showTimes pdbData + let (uncompressedLength, contentId, stream) as pdbStream = generatePortablePdb fixupOverlappingSequencePoints embedAllSource embedSourceList showTimes pdbData if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream) else Some (pdbStream) | _ -> None @@ -4260,6 +4260,8 @@ type options = pdbfile: string option portablePDB: bool embeddedPDB: bool + embedAllSource: bool + embedSourceList: string list signer: ILStrongNameSigner option fixupOverlappingSequencePoints: bool emitTailcalls : bool @@ -4267,6 +4269,6 @@ type options = dumpDebugInfo:bool } let WriteILBinary (outfile, (args: options), modul, noDebugData) = - ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.portablePDB, args.embeddedPDB, - args.fixupOverlappingSequencePoints, args.emitTailcalls, args.showTimes, - args.dumpDebugInfo) modul noDebugData) + ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.portablePDB, args.embeddedPDB, + args.embedAllSource, args.embedSourceList, args.fixupOverlappingSequencePoints, + args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul noDebugData) diff --git a/src/absil/ilwrite.fsi b/src/absil/ilwrite.fsi index 51d1842b20..f1b43e6ae2 100755 --- a/src/absil/ilwrite.fsi +++ b/src/absil/ilwrite.fsi @@ -20,6 +20,8 @@ type options = pdbfile: string option portablePDB: bool embeddedPDB: bool + embedAllSource: bool + embedSourceList: string list signer : ILStrongNameSigner option fixupOverlappingSequencePoints : bool emitTailcalls: bool diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index 9cf0729bd7..64fef2369d 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -19,6 +19,31 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Range + +type BlobBuildingStream () = + inherit Stream() + + static let chunkSize = 32 * 1024 + let builder = new BlobBuilder(chunkSize) + + override this.CanWrite = true + override this.CanRead = false + override this.CanSeek = false + override this.Length = int64(builder.Count) + + override this.Write(buffer:byte array, offset:int, count:int) = builder.WriteBytes(buffer, offset, count) + override this.WriteByte(value:byte) = builder.WriteByte(value) + member this.WriteInt32(value:int) = builder.WriteInt32(value) + member this.ToImmutableArray() = builder.ToImmutableArray() + member this.TryWriteBytes(stream:Stream, length:int) = builder.TryWriteBytes(stream, length) + + override this.Flush() = () + override this.Dispose(_disposing:bool) = () + override this.Seek(_offset:int64, _origin:SeekOrigin) = raise (new NotSupportedException()) + override this.Read(_buffer:byte array, _offset:int, _count:int) = raise (new NotSupportedException()) + override this.SetLength(_value:int64) = raise (new NotSupportedException()) + override val Position = 0L with get, set + // -------------------------------------------------------------------- // PDB types // -------------------------------------------------------------------- @@ -227,7 +252,7 @@ let fixupOverlappingSequencePoints fixupSPs showTimes methods = Array.sortInPlaceBy fst allSps spCounts, allSps -let generatePortablePdb fixupSPs showTimes (info:PdbData) = +let generatePortablePdb fixupSPs (embedAllSource:bool) (embedSourceList:string list) showTimes (info:PdbData) = sortMethods showTimes info let _spCounts, _allSps = fixupOverlappingSequencePoints fixupSPs showTimes info.Methods let externalRowCounts = getRowCounts info.TableRowCounts @@ -253,23 +278,69 @@ let generatePortablePdb fixupSPs showTimes (info:PdbData) = metadata.GetOrAddBlob(writer) let corSymLanguageTypeFSharp = System.Guid(0xAB4F38C9u, 0xB6E6us, 0x43baus, 0xBEuy, 0x3Buy, 0x58uy, 0x08uy, 0x0Buy, 0x2Cuy, 0xCCuy, 0xE3uy) + let embeddedSource = System.Guid(0x0e8a571bu, 0x6926us, 0x466eus, 0xb4uy, 0xaduy, 0x8auy, 0xb0uy, 0x46uy, 0x11uy, 0xf5uy, 0xfeuy) + + /// + /// The maximum number of bytes in to write out uncompressed. + /// + /// This prevents wasting resources on compressing tiny files with little to negative gain + /// in PDB file size. + /// + /// Chosen as the point at which we start to see > 10% blob size reduction using all + /// current source files in corefx and roslyn as sample data. + /// + let sourceCompressionThreshold = 200 + let documentIndex = + let includeSource file = + let isInList = + if embedSourceList.Length = 0 then false + else + embedSourceList |> List.tryFind(fun f -> String.Compare(file, f, StringComparison.OrdinalIgnoreCase ) = 0) |> Option.isSome + + if not embedAllSource && not isInList || not (File.Exists(file)) then + None + else + let stream = File.OpenRead(file) + let length64 = stream.Length + if length64 > int64(Int32.MaxValue) then raise (new IOException("File is too long")) + + let builder = new BlobBuildingStream() + let length = int(length64) + if length < sourceCompressionThreshold then + builder.WriteInt32(0) + builder.TryWriteBytes(stream, length) |> ignore + else + builder.WriteInt32(length) |>ignore + use deflater = new DeflateStream(builder, CompressionMode.Compress, true) + stream.CopyTo(deflater) |> ignore + Some (builder.ToImmutableArray()) + let mutable index = new Dictionary(docs.Length) metadata.SetCapacity(TableIndex.Document, docs.Length) for doc in docs do let handle = match checkSum doc.File with | Some (hashAlg, checkSum) -> - serializeDocumentName doc.File, - metadata.GetOrAddGuid(hashAlg), - metadata.GetOrAddBlob(checkSum.ToImmutableArray()), - metadata.GetOrAddGuid(corSymLanguageTypeFSharp) + let dbgInfo = + (serializeDocumentName doc.File, + metadata.GetOrAddGuid(hashAlg), + metadata.GetOrAddBlob(checkSum.ToImmutableArray()), + metadata.GetOrAddGuid(corSymLanguageTypeFSharp)) |> metadata.AddDocument + match includeSource doc.File with + | None -> () + | Some blob -> + metadata.AddCustomDebugInformation(DocumentHandle.op_Implicit(dbgInfo), + metadata.GetOrAddGuid(embeddedSource), + metadata.GetOrAddBlob(blob)) |> ignore + dbgInfo | None -> - serializeDocumentName doc.File, - metadata.GetOrAddGuid(System.Guid.Empty), - metadata.GetOrAddBlob(ImmutableArray.Empty), - metadata.GetOrAddGuid(corSymLanguageTypeFSharp) - |> metadata.AddDocument + let dbgInfo = + (serializeDocumentName doc.File, + metadata.GetOrAddGuid(System.Guid.Empty), + metadata.GetOrAddBlob(ImmutableArray.Empty), + metadata.GetOrAddGuid(corSymLanguageTypeFSharp)) |> metadata.AddDocument + dbgInfo index.Add(doc.File, handle) index @@ -291,7 +362,7 @@ let generatePortablePdb fixupSPs showTimes (info:PdbData) = else match documentIndex.TryGetValue(docs.[d].File) with | false, _ -> Unchecked.defaultof - | true, f -> f + | true, h -> h if sps.Length = 0 then Unchecked.defaultof, Unchecked.defaultof @@ -306,7 +377,6 @@ let generatePortablePdb fixupSPs showTimes (info:PdbData) = singleDocumentIndex let builder = new BlobBuilder() - builder.WriteCompressedInteger(minfo.LocalSignatureToken) // Initial document: When sp's spread over more than one document we put the initial document here. diff --git a/src/absil/ilwritepdb.fsi b/src/absil/ilwritepdb.fsi index 03ca07c6a9..4d699b3db9 100644 --- a/src/absil/ilwritepdb.fsi +++ b/src/absil/ilwritepdb.fsi @@ -82,7 +82,7 @@ type idd = iddData: byte[]; iddChunk: BinaryChunk } -val generatePortablePdb : fixupSPs:bool -> showTimes:bool -> info:PdbData -> (int64 * BlobContentId * MemoryStream) +val generatePortablePdb : fixupSPs:bool -> embedAllSource:bool -> embedSourceList:string list -> showTimes:bool -> info:PdbData -> (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[] diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index b8f1c0107b..ad8260546b 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2115,6 +2115,9 @@ type TcConfigBuilder = mutable jitTracking : bool mutable portablePDB : bool mutable embeddedPDB : bool + mutable embedAllSource : bool + mutable embedSourceList : string list + mutable ignoreSymbolStoreSequencePoints : bool mutable internConstantStrings : bool mutable extraOptimizationIterations : int @@ -2286,7 +2289,9 @@ type TcConfigBuilder = useSignatureDataFile = false jitTracking = true portablePDB = true - embeddedPDB = true + embeddedPDB = false + embedAllSource = false + embedSourceList = [] ignoreSymbolStoreSequencePoints = false internConstantStrings = true extraOptimizationIterations = 0 @@ -2416,7 +2421,7 @@ type TcConfigBuilder = | None -> false 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)) @@ -2429,7 +2434,9 @@ type TcConfigBuilder = ComputeMakePathAbsolute pathLoadedFrom path if not (List.contains path (List.map snd tcConfigB.loadedSources)) then tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m,path) - + + member tcConfigB.AddEmbeddedSourceFile (file) = + tcConfigB.embedSourceList <- tcConfigB.embedSourceList ++ file member tcConfigB.AddEmbeddedResource filename = tcConfigB.embedResources <- tcConfigB.embedResources ++ filename @@ -2771,6 +2778,8 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member x.jitTracking = data.jitTracking member x.portablePDB = data.portablePDB member x.embeddedPDB = data.embeddedPDB + member x.embedAllSource = data.embedAllSource + member x.embedSourceList = data.embedSourceList member x.ignoreSymbolStoreSequencePoints = data.ignoreSymbolStoreSequencePoints member x.internConstantStrings = data.internConstantStrings member x.extraOptimizationIterations = data.extraOptimizationIterations @@ -2835,7 +2844,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = (sourceFiles |> List.mapi (fun i _ -> (i = n-1)), tcConfig.target.IsExe) // This call can fail if no CLR is found (this is the path to mscorlib) - member tcConfig.ClrRoot = + member tcConfig.TargetFrameworkDirectories = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) match tcConfig.clrRoot with | Some x -> @@ -2907,7 +2916,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.IsSystemAssembly (filename:string) = try FileSystem.SafeExists filename && - ((tcConfig.ClrRoot |> List.exists (fun clrRoot -> clrRoot = Path.GetDirectoryName filename)) || + ((tcConfig.TargetFrameworkDirectories |> List.exists (fun clrRoot -> clrRoot = Path.GetDirectoryName filename)) || (systemAssemblies |> List.exists (fun sysFile -> sysFile = fileNameWithoutExtension filename))) with _ -> false @@ -2915,7 +2924,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // This is not the complete set of search paths, it is just the set // that is special to F# (as compared to MSBuild resolution) member tcConfig.SearchPathsForLibraryFiles = - [ yield! tcConfig.ClrRoot + [ yield! tcConfig.TargetFrameworkDirectories yield! List.map (tcConfig.MakePathAbsolute) tcConfig.includes yield tcConfig.implicitIncludeDir yield tcConfig.fsharpBinariesDir ] @@ -3040,13 +3049,16 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = assemblyName, highestPosition, assemblyGroup) |> Array.ofSeq - let logmessage showMessages = + let logMessage showMessages = if showMessages && tcConfig.showReferenceResolutions then (fun (message:string)->dprintf "%s\n" message) else ignore - let logwarning showMessages = - (fun code message-> + let logErrorOrWarning showMessages = + (fun isError code message-> if showMessages && mode = ReportErrors then + if isError then + errorR(MSBuildReferenceResolutionError(code,message,errorAndWarningRange)) + else match code with // These are warnings that mean 'not resolved' for some assembly. // Note that we don't get to know the name of the assembly that couldn't be resolved. @@ -3055,15 +3067,10 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | "MSB3106" -> () | _ -> - (if code = "MSB3245" then errorR else warning) - (MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange))) - - let logerror showMessages = - (fun code message -> - if showMessages && mode = ReportErrors then - errorR(MSBuildReferenceResolutionError(code,message,errorAndWarningRange))) - - let targetFrameworkVersion = tcConfig.targetFrameworkVersion + if code = "MSB3245" then + errorR(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange)) + else + warning(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange))) let targetProcessorArchitecture = match tcConfig.platform with @@ -3072,13 +3079,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(AMD64) -> "amd64" | Some(IA64) -> "ia64" - let outputDirectory = - match tcConfig.outputFile with - | Some(outputFile) -> tcConfig.MakePathAbsolute outputFile - | None -> tcConfig.implicitIncludeDir - - let targetFrameworkDirectories = tcConfig.ClrRoot - // First, try to resolve everything as a file using simple resolution let resolvedAsFile = groupedReferences @@ -3094,14 +3094,13 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = tcConfig.referenceResolver.Resolve (tcConfig.resolutionEnvironment, references, - targetFrameworkVersion, - targetFrameworkDirectories, + tcConfig.targetFrameworkVersion, + tcConfig.TargetFrameworkDirectories, targetProcessorArchitecture, - Path.GetDirectoryName(outputDirectory), tcConfig.fsharpBinariesDir, // FSharp binaries directory tcConfig.includes, // Explicit include directories tcConfig.implicitIncludeDir, // Implicit include directory (likely the project directory) - logmessage showMessages, logwarning showMessages, logerror showMessages) + logMessage showMessages, logErrorOrWarning showMessages) with ReferenceResolver.ResolutionFailure -> error(Error(FSComp.SR.buildAssemblyResolutionFailed(),errorAndWarningRange)) @@ -4300,38 +4299,25 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let invalidateCcu = new Event<_>() #endif - // Adjust where the code for known F# libraries live relative to the installation of F# - let codeDir = - let dir = minfo.compileTimeWorkingDir - let knownLibraryLocation = @"src\fsharp\" // Help highlighting... " - let knownLibarySuffixes = - [ @"FSharp.Core" - @"FSharp.PowerPack" - @"FSharp.PowerPack.Linq" - @"FSharp.PowerPack.Metadata" ] - match knownLibarySuffixes |> List.tryFind (fun x -> dir.EndsWith(knownLibraryLocation + x,StringComparison.OrdinalIgnoreCase)) with - | None -> - dir - | Some libSuffix -> - // add "..\lib\FSharp.Core" to the F# binaries directory - Path.Combine(Path.Combine(tcConfig.fsharpBinariesDir,@"..\lib"),libSuffix) - - let ccu = - CcuThunk.Create(ccuName, { ILScopeRef=ilScopeRef - Stamp = newStamp() - FileName = Some filename - QualifiedName= Some(ilScopeRef.QualifiedName) - SourceCodeDirectory = codeDir (* note: in some cases we fix up this information later *) - IsFSharp=true - Contents = mspec + let codeDir = minfo.compileTimeWorkingDir + let ccuData : CcuData = + { ILScopeRef=ilScopeRef + Stamp = newStamp() + FileName = Some filename + QualifiedName= Some(ilScopeRef.QualifiedName) + SourceCodeDirectory = codeDir (* note: in some cases we fix up this information later *) + IsFSharp=true + Contents = mspec #if EXTENSIONTYPING - InvalidateEvent=invalidateCcu.Publish - IsProviderGenerated = false - ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) + InvalidateEvent=invalidateCcu.Publish + IsProviderGenerated = false + ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) #endif - UsesFSharp20PlusQuotations = minfo.usesQuotations - MemberSignatureEquality= (fun ty1 ty2 -> Tastops.typeEquivAux EraseAll (tcImports.GetTcGlobals()) ty1 ty2) - TypeForwarders = ImportILAssemblyTypeForwarders(tcImports.GetImportMap,m, ilModule.GetRawTypeForwarders()) }) + UsesFSharp20PlusQuotations = minfo.usesQuotations + MemberSignatureEquality= (fun ty1 ty2 -> Tastops.typeEquivAux EraseAll (tcImports.GetTcGlobals()) ty1 ty2) + TypeForwarders = ImportILAssemblyTypeForwarders(tcImports.GetImportMap,m, ilModule.GetRawTypeForwarders()) } + + let ccu = CcuThunk.Create(ccuName, ccuData) let optdata = lazy @@ -4346,15 +4332,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti Some res) let ilg = defaultArg ilGlobalsOpt EcmaILGlobals let ccuinfo = - { FSharpViewOfMetadata=ccu - AssemblyAutoOpenAttributes = ilModule.GetAutoOpenAttributes(ilg) - AssemblyInternalsVisibleToAttributes = ilModule.GetInternalsVisibleToAttributes(ilg) - FSharpOptimizationData=optdata + { FSharpViewOfMetadata=ccu + AssemblyAutoOpenAttributes = ilModule.GetAutoOpenAttributes(ilg) + AssemblyInternalsVisibleToAttributes = ilModule.GetInternalsVisibleToAttributes(ilg) + FSharpOptimizationData=optdata #if EXTENSIONTYPING - IsProviderGenerated = false - TypeProviders = [] + IsProviderGenerated = false + TypeProviders = [] #endif - ILScopeRef = ilScopeRef } + ILScopeRef = ilScopeRef } let phase2() = #if EXTENSIONTYPING match ilModule.TryGetRawILModule() with @@ -4403,15 +4389,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let phase2() = [tcImports.FindCcuInfo(m,ilShortAssemName,lookupOnly=true)] dllinfo,phase2 else - let dllinfo = {RawMetadata=assemblyData - FileName=filename + let dllinfo = + { RawMetadata=assemblyData + FileName=filename #if EXTENSIONTYPING - ProviderGeneratedAssembly=None - IsProviderGenerated=false - ProviderGeneratedStaticLinkMap = None + ProviderGeneratedAssembly=None + IsProviderGenerated=false + ProviderGeneratedStaticLinkMap = None #endif - ILScopeRef = ilScopeRef - ILAssemblyRefs = assemblyData.ILAssemblyRefs } + ILScopeRef = ilScopeRef + ILAssemblyRefs = assemblyData.ILAssemblyRefs } tcImports.RegisterDll(dllinfo) let ilg = defaultArg ilGlobalsOpt EcmaILGlobals let phase2 = @@ -5209,26 +5196,31 @@ type TcState = tcsTcImplEnv = tcEnvAtEndOfLastInput } +/// Create the initial type checking state for compiling an assembly let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports,niceNameGen,tcEnv0) = ignore tcImports + // Create a ccu to hold all the results of compilation let ccuType = NewCcuContents ILScopeRef.Local m ccuName (NewEmptyModuleOrNamespaceType Namespace) - let ccu = - CcuThunk.Create(ccuName,{IsFSharp=true - UsesFSharp20PlusQuotations=false + + let ccuData : CcuData = + { IsFSharp=true + UsesFSharp20PlusQuotations=false #if EXTENSIONTYPING - InvalidateEvent=(new Event<_>()).Publish - IsProviderGenerated = false - ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) + InvalidateEvent=(new Event<_>()).Publish + IsProviderGenerated = false + ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) #endif - FileName=None - Stamp = newStamp() - QualifiedName= None - SourceCodeDirectory = tcConfig.implicitIncludeDir - ILScopeRef=ILScopeRef.Local - Contents=ccuType - MemberSignatureEquality= (Tastops.typeEquivAux EraseAll tcGlobals) - TypeForwarders=Map.empty }) + FileName=None + Stamp = newStamp() + QualifiedName= None + SourceCodeDirectory = tcConfig.implicitIncludeDir + ILScopeRef=ILScopeRef.Local + Contents=ccuType + MemberSignatureEquality= (Tastops.typeEquivAux EraseAll tcGlobals) + TypeForwarders=Map.empty } + + let ccu = CcuThunk.Create(ccuName,ccuData) // OK, is this is the FSharp.Core CCU then fix it up. if tcConfig.compilingFslib then @@ -5246,7 +5238,7 @@ let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports, tcsRootSigsAndImpls = RootSigsAndImpls (rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) } -/// Typecheck a single file or interactive entry into F# Interactive +/// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInputEventually (checkForErrors , tcConfig:TcConfig, tcImports:TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = @@ -5357,12 +5349,14 @@ let TypeCheckOneInputEventually return (tcState.TcEnvFromSignatures,EmptyTopAttrs,[]),tcState } +/// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false,GetScopedPragmasForInput(inp),oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp) |> Eventually.force +/// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results,tcState: TcState) = let tcEnvsAtEndFile,topAttrs,mimpls = List.unzip3 results @@ -5373,11 +5367,12 @@ let TypeCheckMultipleInputsFinish(results,tcState: TcState) = (tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState +/// Check multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputs (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = let results,tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) TypeCheckMultipleInputsFinish(results,tcState) -let TypeCheckSingleInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = +let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { let! results,tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) return TypeCheckMultipleInputsFinish([results],tcState) diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index c24e760ab9..769fbe33f9 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -308,6 +308,8 @@ type TcConfigBuilder = mutable jitTracking : bool mutable portablePDB : bool mutable embeddedPDB : bool + mutable embedAllSource : bool + mutable embedSourceList : string list mutable ignoreSymbolStoreSequencePoints : bool mutable internConstantStrings : bool mutable extraOptimizationIterations : int @@ -380,6 +382,7 @@ type TcConfigBuilder = member AddIncludePath : range * string * string -> unit member AddReferencedAssemblyByPath : range * string -> unit member RemoveReferencedAssemblyByPath : range * string -> unit + member AddEmbeddedSourceFile : string -> unit member AddEmbeddedResource : string -> unit static member SplitCommandLineResourceInfo : string -> string * string * ILResourceAccess @@ -461,6 +464,8 @@ type TcConfig = member jitTracking : bool member portablePDB : bool member embeddedPDB : bool + member embedAllSource : bool + member embedSourceList : string list member ignoreSymbolStoreSequencePoints : bool member internConstantStrings : bool member extraOptimizationIterations : int @@ -510,7 +515,7 @@ type TcConfig = member ComputeLightSyntaxInitialStatus : string -> bool - member ClrRoot : string list + member TargetFrameworkDirectories : string list /// Get the loaded sources that exist and issue a warning for the ones that don't member GetAvailableLoadedSources : unit -> (range*string) list @@ -730,7 +735,7 @@ val TypeCheckClosedInputSetFinish : TypedImplFile list * TcState -> TcState * Ty val TypeCheckClosedInputSet :(unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput list -> TcState * TopAttribs * TypedImplFile list * TcEnv /// Check a single input and finish the checking -val TypeCheckSingleInputAndFinishEventually : +val TypeCheckOneInputAndFinishEventually : (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState> diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 0efae33e96..f74f5fa427 100755 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -422,7 +422,7 @@ let SetOptimizeOn(tcConfigB : TcConfigBuilder) = let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) - + let SetTailcallSwitch (tcConfigB : TcConfigBuilder) switch = tcConfigB.emitTailcalls <- (switch = OptionSwitch.On) @@ -479,6 +479,9 @@ let SetDebugSwitch (tcConfigB : TcConfigBuilder) (dtype : string option) (s : Op | None -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- s = OptionSwitch.On; tcConfigB.debuginfo <- s = OptionSwitch.On +let SetEmbedAllSourceSwitch (tcConfigB : TcConfigBuilder) switch = + if (switch = OptionSwitch.On) then tcConfigB.embedAllSource <- true else tcConfigB.embedAllSource <- false + let setOutFileName tcConfigB s = tcConfigB.outputFile <- Some s @@ -504,7 +507,6 @@ let tagAddress = "
" let tagInt = "" let tagNone = "" - // PrintOptionInfo //---------------- @@ -521,6 +523,8 @@ let PrintOptionInfo (tcConfigB:TcConfigBuilder) = printfn " jitTracking . . . . . : %+A" tcConfigB.jitTracking printfn " portablePDB. . . . . . : %+A" tcConfigB.portablePDB printfn " embeddedPDB. . . . . . : %+A" tcConfigB.embeddedPDB + printfn " embedAllSource . . . . : %+A" tcConfigB.embedAllSource + printfn " embedSourceList. . . . : %+A" tcConfigB.embedSourceList printfn " debuginfo . . . . . . : %+A" tcConfigB.debuginfo printfn " resolutionEnvironment : %+A" tcConfigB.resolutionEnvironment printfn " product . . . . . . . : %+A" tcConfigB.productNameForBannerText @@ -569,7 +573,7 @@ let errorsAndWarningsFlags (tcConfigB : TcConfigBuilder) = CompilerOption("nowarn", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOff(rangeCmdArgs,n)), None, Some (FSComp.SR.optsNowarn())); - + CompilerOption("warnon", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOn(rangeCmdArgs,n)), None, Some(FSComp.SR.optsWarnOn())); @@ -657,24 +661,28 @@ let resourcesFlagsFsc (tcConfigB : TcConfigBuilder) = //----------------------------- let codeGenerationFlags isFsi (tcConfigB : TcConfigBuilder) = - [ - CompilerOption("debug", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, - Some (FSComp.SR.optsDebugPM())) - - CompilerOption("debug", tagFullPDBOnlyPortable, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None, - Some (FSComp.SR.optsDebug(if isFsi then "pdbonly" else "full"))) - - CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, - Some (FSComp.SR.optsOptimize())) - - CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None, - Some (FSComp.SR.optsTailcalls())) - - CompilerOption("crossoptimize", tagNone, OptionSwitch (crossOptimizeSwitch tcConfigB), None, - Some (FSComp.SR.optsCrossoptimize())) - - ] - + let debug = + [CompilerOption("debug", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, + Some (FSComp.SR.optsDebugPM())) + CompilerOption("debug", tagFullPDBOnlyPortable, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None, + Some (FSComp.SR.optsDebug(if isFsi then "pdbonly" else "full"))) + ] + let embed = + [CompilerOption("embed", tagNone, OptionSwitch (SetEmbedAllSourceSwitch tcConfigB) , None, + Some (FSComp.SR.optsEmbedAllSource())) + CompilerOption("embed", tagFileList, OptionStringList (fun f -> tcConfigB.AddEmbeddedSourceFile f), None, + Some ( FSComp.SR.optsEmbedSource())); + ] + let codegen = + [CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, + Some (FSComp.SR.optsOptimize())) + CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None, + Some (FSComp.SR.optsTailcalls())) + CompilerOption("crossoptimize", tagNone, OptionSwitch (crossOptimizeSwitch tcConfigB), None, + Some (FSComp.SR.optsCrossoptimize())) + ] + if isFsi then debug @ codegen + else debug @ embed @ codegen // OptionBlock: Language //---------------------- @@ -824,7 +832,6 @@ let vsSpecificFlags (tcConfigB: TcConfigBuilder) = CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None) CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) ] - let internalFlags (tcConfigB:TcConfigBuilder) = [ CompilerOption("stamps", tagNone, OptionUnit (fun () -> ()), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None) diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 3534eb3a02..c3b8fe735b 100755 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -836,6 +836,9 @@ optsReference,"Reference an assembly (Short form: -r)" optsWin32res,"Specify a Win32 resource file (.res)" optsWin32manifest,"Specify a Win32 manifest file" optsNowin32manifest,"Do not include the default Win32 manifest" +optsEmbedAllSource,"Embed all source files in the portable PDB file" +optsEmbedSource,"Embed specific source files in the portable PDB file" +1501,optsEmbeddedSourceRequirePortablePDBs,"--embed switch only supported when emitting a Portable PDB (--debug:portable or --debug:embedded)" optsResource,"Embed the specified managed resource" optsLinkresource,"Link the specified resource to this assembly where the resinfo format is [,[,public|private]]" optsDebugPM,"Emit debug information (Short form: -g)" diff --git a/src/fsharp/MSBuildReferenceResolver.fs b/src/fsharp/MSBuildReferenceResolver.fs index a430cdcb5d..44b99c02ff 100644 --- a/src/fsharp/MSBuildReferenceResolver.fs +++ b/src/fsharp/MSBuildReferenceResolver.fs @@ -1,8 +1,10 @@ // 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. -namespace Microsoft.FSharp.Compiler +module internal Microsoft.FSharp.Compiler.MSBuildReferenceResolver -module internal MSBuildReferenceResolver = + open System + open System.IO + open System.Reflection #if FX_RESHAPED_REFLECTION @@ -15,12 +17,9 @@ module internal MSBuildReferenceResolver = open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.ReferenceResolver - open System open Microsoft.Build.Tasks open Microsoft.Build.Utilities open Microsoft.Build.Framework - open System.IO - open System.Reflection /// Get the Reference Assemblies directory for the .NET Framework on Window. let DotNetFrameworkReferenceAssembliesRootDirectory = @@ -170,38 +169,41 @@ module internal MSBuildReferenceResolver = let TooltipForResolvedFrom(resolvedFrom, fusionName, redist) = fun (originalReference,resolvedPath) -> let originalReferenceName = originalReference + let resolvedPath = // Don't show the resolved path if it is identical to what was referenced. if originalReferenceName = resolvedPath then String.Empty else resolvedPath - let lineIfExists(append) = - if not(String.IsNullOrEmpty(append)) then append.Trim([|' '|])+"\n" - else "" + + let lineIfExists text = + if String.IsNullOrEmpty text then "" + else text.Trim(' ')+"\n" + match resolvedFrom with | AssemblyFolders -> - lineIfExists(resolvedPath) - + lineIfExists(fusionName) - + (FSComp.SR.assemblyResolutionFoundByAssemblyFoldersKey()) + lineIfExists resolvedPath + + lineIfExists fusionName + + FSComp.SR.assemblyResolutionFoundByAssemblyFoldersKey() | AssemblyFoldersEx -> - lineIfExists(resolvedPath) - + lineIfExists(fusionName) - + (FSComp.SR.assemblyResolutionFoundByAssemblyFoldersExKey()) + lineIfExists resolvedPath + + lineIfExists fusionName + + FSComp.SR.assemblyResolutionFoundByAssemblyFoldersExKey() | TargetFrameworkDirectory -> - lineIfExists(resolvedPath) - + lineIfExists(fusionName) - + (FSComp.SR.assemblyResolutionNetFramework()) + lineIfExists resolvedPath + + lineIfExists fusionName + + FSComp.SR.assemblyResolutionNetFramework() | Unknown -> // Unknown when resolved by plain directory search without help from MSBuild resolver. - lineIfExists(resolvedPath) - + lineIfExists(fusionName) + lineIfExists resolvedPath + + lineIfExists fusionName | RawFileName -> - lineIfExists(fusionName) + lineIfExists fusionName | GlobalAssemblyCache -> - lineIfExists(fusionName) - + (FSComp.SR.assemblyResolutionGAC())+ "\n" - + lineIfExists(redist) + lineIfExists fusionName + + lineIfExists (FSComp.SR.assemblyResolutionGAC()) + + lineIfExists redist | Path _ -> - lineIfExists(resolvedPath) - + lineIfExists(fusionName) + lineIfExists resolvedPath + + lineIfExists fusionName /// Perform assembly resolution by instantiating the ResolveAssemblyReference task directly from the MSBuild SDK. let ResolveCore(resolutionEnvironment: ResolutionEnvironment, @@ -209,14 +211,12 @@ module internal MSBuildReferenceResolver = targetFrameworkVersion: string, targetFrameworkDirectories: string list, targetProcessorArchitecture: string, - outputDirectory: string, fsharpCoreDir: string, explicitIncludeDirs: string list, implicitIncludeDir: string, allowRawFileName: bool, logMessage: (string -> unit), - logWarning: (string -> string -> unit), - logError: (string -> string -> unit)) = + logErrorOrWarning: (bool -> string -> string -> unit)) = let frameworkRegistryBase, assemblyFoldersSuffix, assemblyFoldersConditions = "Software\Microsoft\.NetFramework", "AssemblyFoldersEx" , "" @@ -234,14 +234,14 @@ module internal MSBuildReferenceResolver = member __.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true #if RESHAPED_MSBUILD member __.LogCustomEvent(e) = protect (fun () -> logMessage ((e.GetPropertyValue("Message")) :?> string)) - member __.LogErrorEvent(e) = protect (fun () -> logError ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)) + member __.LogErrorEvent(e) = protect (fun () -> logErrorOrWarning true ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)) member __.LogMessageEvent(e) = protect (fun () -> logMessage ((e.GetPropertyValue("Message")) :?> string)) - member __.LogWarningEvent(e) = protect (fun () -> logWarning ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)) + member __.LogWarningEvent(e) = protect (fun () -> logErrorOrWarning false ((e.GetPropertyValue("Code")) :?> string) ((e.GetPropertyValue("Message")) :?> string)) #else member __.LogCustomEvent(e) = protect (fun () -> logMessage e.Message) - member __.LogErrorEvent(e) = protect (fun () -> logError e.Code e.Message) + member __.LogErrorEvent(e) = protect (fun () -> logErrorOrWarning true e.Code e.Message) member __.LogMessageEvent(e) = protect (fun () -> logMessage e.Message) - member __.LogWarningEvent(e) = protect (fun () -> logWarning e.Code e.Message) + member __.LogWarningEvent(e) = protect (fun () -> logErrorOrWarning false e.Code e.Message) #endif member __.ColumnNumberOfTaskNode with get() = 1 member __.LineNumberOfTaskNode with get() = 1 @@ -257,36 +257,36 @@ module internal MSBuildReferenceResolver = // Filter for null and zero length let references = references |> Array.filter(fst >> String.IsNullOrEmpty >> not) - let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else [] - + // Determine the set of search paths for the resolution 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 - [fsharpCoreDir] @ // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe - [implicitIncludeDir] @ // Usually the project directory - ["{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 - [fsharpCoreDir] @ // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe - [implicitIncludeDir] @ // Usually the project directory - [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ // Like {Registry:Software\Microsoft\.NETFramework,v2.0,AssemblyFoldersEx} - ["{AssemblyFolders}"] @ - [outputDirectory] @ - ["{GAC}"] @ + + let explicitIncludeDirs = explicitIncludeDirs |> List.filter(String.IsNullOrEmpty >> not) + + let registry = sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions + + [| // When compiling scripts, for some reason we have always historically put TargetFrameworkDirectory first + // It is unclear why. + match resolutionEnvironment with + | CompileTimeLike -> yield "{TargetFrameworkDirectory}" + | DesignTimeLike | RuntimeLike -> () + + // Quick-resolve straight to filename first + if allowRawFileName then + yield "{RawFileName}" + yield! explicitIncludeDirs // From -I, #I + yield fsharpCoreDir // Location of explicit reference to FSharp.Core, otherwise location of fsc.exe + yield implicitIncludeDir // Usually the project directory + + match resolutionEnvironment with + | DesignTimeLike | RuntimeLike -> yield "{TargetFrameworkDirectory}" + | CompileTimeLike -> () + + yield registry + yield "{AssemblyFolders}" + yield "{GAC}" // use path to implementation assemblies as the last resort - GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion + yield! GetPathToDotNetFrameworkImlpementationAssemblies targetFrameworkVersion + |] let assemblies = #if RESHAPED_MSBUILD @@ -302,10 +302,13 @@ module internal MSBuildReferenceResolver = ResolveAssemblyReference(BuildEngine=engine, TargetFrameworkDirectories=targetFrameworkDirectories, FindRelatedFiles=false, FindDependencies=false, FindSatellites=false, FindSerializationAssemblies=false, Assemblies=assemblies, + SearchPaths=searchPaths, AllowedAssemblyExtensions= [| ".dll" ; ".exe" |]) #if BUILDING_WITH_LKG ignore targetProcessorArchitecture #else +#if FX_RESHAPED_REFLECTION +#else rar.TargetProcessorArchitecture <- targetProcessorArchitecture let targetedRuntimeVersionValue = typeof.Assembly.ImageRuntimeVersion #if CROSS_PLATFORM_COMPILER @@ -316,31 +319,10 @@ module internal MSBuildReferenceResolver = if not runningOnMono then typeof.InvokeMember("TargetedRuntimeVersion",(BindingFlags.Instance ||| BindingFlags.SetProperty ||| BindingFlags.Public),null,rar,[| box targetedRuntimeVersionValue |]) |> ignore typeof.InvokeMember("CopyLocalDependenciesWhenParentReferenceInGac",(BindingFlags.Instance ||| BindingFlags.SetProperty ||| BindingFlags.Public),null,rar,[| box true |]) |> ignore -#else -#if FX_RESHAPED_REFLECTION -#else - rar.TargetedRuntimeVersion <- targetedRuntimeVersionValue #endif - rar.CopyLocalDependenciesWhenParentReferenceInGac <- true -#endif - #endif - - rar.Assemblies <- -#if RESHAPED_MSBUILD - [||] -#else - [| for (referenceName,baggage) in references -> - let item = new Microsoft.Build.Utilities.TaskItem(referenceName) :> ITaskItem - item.SetMetadata("Baggage", baggage) - item - |] #endif - - rar.SearchPaths <- searchPaths |> Array.ofList - - rar.AllowedAssemblyExtensions <- [| ".dll" ; ".exe" |] - + let succeeded = rar.Execute() if not succeeded then @@ -357,44 +339,39 @@ module internal MSBuildReferenceResolver = resolvedFiles - /// Perform the resolution on rooted and unrooted paths, and then combine the results. - let Resolve(resolutionEnvironment, references, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, - outputDirectory, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logWarning, logError) = - - // 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 = - [| for ((file,baggage) as data) in references -> - // 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 - (Path.Combine(implicitIncludeDir, file), baggage) |] - - let rooted, unrooted = references |> Array.partition (fst >> FileSystem.IsPathRootedShim) - - let rootedResults = ResolveCore(resolutionEnvironment, rooted, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, outputDirectory, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, true, logMessage, logWarning, logError) - - let unrootedResults = ResolveCore(resolutionEnvironment, unrooted, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, outputDirectory, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, false, logMessage, logWarning, logError) - - // now unify the two sets of results - Array.concat [| rootedResults; unrootedResults |] - let Resolver = { new ReferenceResolver.Resolver with member __.HighestInstalledNetFrameworkVersion() = HighestInstalledNetFrameworkVersion() member __.DotNetFrameworkReferenceAssembliesRootDirectory = DotNetFrameworkReferenceAssembliesRootDirectory - member __.Resolve(resolutionEnvironment, references, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, - outputDirectory, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logWarning, logError) = - Resolve(resolutionEnvironment, references, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, - outputDirectory, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logWarning, logError) + /// Perform the resolution on rooted and unrooted paths, and then combine the results. + member __.Resolve(resolutionEnvironment, references, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, + fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, logMessage, logErrorOrWarning) = + + // 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 = + [| for ((file,baggage) as data) in references -> + // 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 + (Path.Combine(implicitIncludeDir, file), baggage) |] + + let rooted, unrooted = references |> Array.partition (fst >> FileSystem.IsPathRootedShim) + + let rootedResults = ResolveCore(resolutionEnvironment, rooted, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, true, logMessage, logErrorOrWarning) + + let unrootedResults = ResolveCore(resolutionEnvironment, unrooted, targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, fsharpCoreDir, explicitIncludeDirs, implicitIncludeDir, false, logMessage, logErrorOrWarning) + + // now unify the two sets of results + Array.concat [| rootedResults; unrootedResults |] } diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index b8e27b4003..542918cc96 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -152,13 +152,11 @@ module (*internal*) Microsoft.FSharp.Compiler.PrettyNaming /// Memoize compilation of custom operators. /// They're typically used more than once so this avoids some CPU and GC overhead. - let compiledOperators = ConcurrentDictionary<_,_> (System.StringComparer.Ordinal) + let compiledOperators = ConcurrentDictionary<_,string> (System.StringComparer.Ordinal) - fun op -> + fun opp -> // Has this operator already been compiled? - match compiledOperators.TryGetValue op with - | true, opName -> opName - | false, _ -> + compiledOperators.GetOrAdd(opp, fun (op:string) -> let opLength = op.Length let sb = new System.Text.StringBuilder (opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) for i = 0 to opLength - 1 do @@ -173,8 +171,7 @@ module (*internal*) Microsoft.FSharp.Compiler.PrettyNaming let opName = sb.ToString () // Cache the compiled name so it can be reused. - compiledOperators.TryAdd (op, opName) |> ignore - opName + opName) // +++ GLOBAL STATE /// Compiles an operator into a mangled operator name. diff --git a/src/fsharp/ReferenceResolver.fs b/src/fsharp/ReferenceResolver.fs index d9e48bcd69..8228ac8da9 100644 --- a/src/fsharp/ReferenceResolver.fs +++ b/src/fsharp/ReferenceResolver.fs @@ -48,11 +48,9 @@ module internal ReferenceResolver = targetFrameworkVersion:string * targetFrameworkDirectories:string list * targetProcessorArchitecture:string * - outputDirectory: string * fsharpCoreDir:string * explicitIncludeDirs:string list * implicitIncludeDir:string * - logmessage:(string->unit) * - logwarning:(string->string->unit) * - logerror:(string->string->unit) + logMessage:(string->unit) * + logErrorOrWarning:(bool -> string -> string -> unit) -> ResolvedFile[] diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index efbf33fcf2..1a5b753a28 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1344,7 +1344,9 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa |> List.map (fun (nm,tcref,builder) -> nm, (fun tcref2 tinst -> if tyconRefEq tcref tcref2 then Some(builder tinst) else None)) |> Dictionary.ofList (fun tcref tinst -> - if dict.Value.ContainsKey tcref.LogicalName then dict.Value.[tcref.LogicalName] tcref tinst + let dict = dict.Value + let key = tcref.LogicalName + if dict.ContainsKey key then dict.[key] tcref tinst else None ) else // This map is for use in normal times (not building FSharp.Core.dll). It is indexed by tcref stamp which is @@ -1360,7 +1362,9 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa |> List.map (fun (_,tcref,builder) -> tcref.Stamp, builder) |> Dictionary.ofList (fun tcref2 tinst -> - if dict.Value.ContainsKey tcref2.Stamp then Some(dict.Value.[tcref2.Stamp] tinst) + let dict = dict.Value + let key = tcref2.Stamp + if dict.ContainsKey key then Some(dict.[key] tinst) else None) end diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 2e2c3f7421..8d05baaa02 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -268,9 +268,12 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder,setProcessThreadLocals,a else inputFilesRef := name :: !inputFilesRef let abbrevArgs = GetAbbrevFlagSet tcConfigB true - + // This is where flags are interpreted by the command line fsc.exe. ParseCompilerOptions (collect, GetCoreFscCompilerOptions tcConfigB, List.tail (PostProcessCompilerArgs abbrevArgs argv)) + if (tcConfigB.embedAllSource || tcConfigB.embedSourceList |> List.length <> 0) && (not (tcConfigB.portablePDB || tcConfigB.embeddedPDB)) then + error(Error(FSComp.SR.optsEmbeddedSourceRequirePortablePDBs(),rangeCmdArgs)) + let inputFiles = List.rev !inputFilesRef #if FX_LCIDFROMCODEPAGE @@ -335,12 +338,12 @@ let GetTcImportsFromCommandLine // Rather than start processing, just collect names, then process them. try let sourceFiles = - let files = ProcessCommandLineFlags (tcConfigB, setProcessThreadLocals, + let files = ProcessCommandLineFlags (tcConfigB, setProcessThreadLocals, #if FX_LCIDFROMCODEPAGE lcidFromCodePage, #endif argv) - AdjustForScriptCompile(tcConfigB,files,lexResourceManager) + AdjustForScriptCompile(tcConfigB,files,lexResourceManager) sourceFiles with e -> @@ -1750,6 +1753,8 @@ module FileWriter = showTimes = tcConfig.showTimes portablePDB = tcConfig.portablePDB embeddedPDB = tcConfig.embeddedPDB + embedAllSource = tcConfig.embedAllSource + embedSourceList = tcConfig.embedSourceList signer = GetSigner signingInfo fixupOverlappingSequencePoints = false dumpDebugInfo = tcConfig.dumpDebugInfo }, diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index f6178a4713..4ecac12c36 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1082,7 +1082,7 @@ type TypeCheckAccumulator = /// Global service state -type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*ClrRoot*)string list* (*fsharpBinaries*)string +type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list* (*fsharpBinaries*)string type FrameworkImportsCache(keepStrongly) = let frameworkTcImportsCache = AgedLookup(keepStrongly, areSame=(fun (x,y) -> x = y)) @@ -1097,6 +1097,7 @@ type FrameworkImportsCache(keepStrongly) = frameworkDLLs |> List.map (fun ar->ar.resolvedPath) // The cache key. Just the minimal data. |> List.sort // Sort to promote cache hits. + let tcGlobals,frameworkTcImports = // Prepare the frameworkTcImportsCache // @@ -1105,7 +1106,7 @@ type FrameworkImportsCache(keepStrongly) = // FSharp.Core.dll and mscorlib.dll) must be logically invariant of all the other compiler configuration parameters. let key = (frameworkDLLsKey, tcConfig.primaryAssembly.Name, - tcConfig.ClrRoot, + tcConfig.TargetFrameworkDirectories, tcConfig.fsharpBinariesDir) match frameworkTcImportsCache.TryGet key with | Some res -> res diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 19c4401bc2..182d63ffa0 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1674,7 +1674,7 @@ module internal Parser = let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. - let computation = TypeCheckSingleInputAndFinishEventually(checkForErrors,tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) + let computation = TypeCheckOneInputAndFinishEventually(checkForErrors,tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) match computation |> Eventually.forceWhile (fun () -> not (isResultObsolete())) with | Some((tcEnvAtEnd,_,typedImplFiles),tcState) -> Some (tcEnvAtEnd, typedImplFiles, tcState) | None -> None // Means 'aborted'