From 48a2f59cc043620fcd209110111d6b49bb7b9251 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Sat, 24 Mar 2018 22:36:24 +0300 Subject: [PATCH 01/24] Remove duplicate illex.fsl include (#4621) --- fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj | 4 ---- 1 file changed, 4 deletions(-) diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index ce45abbc3176..39664cc417d0 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -278,10 +278,6 @@ ILXErase/EraseUnions.fs - - --unicode --lexlib Internal.Utilities.Text.Lexing - AbsIL/illex.fsl - --unicode --lexlib Internal.Utilities.Text.Lexing ParserAndUntypedAST/lex.fsl From 432784c98929b9f678fe15db2a84e1b7d12789d5 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 27 Mar 2018 17:38:10 +0100 Subject: [PATCH 02/24] Fix FCS problem with duplicate ByteFile (#4629) * fix memory usage for FCS case * use explicit version flag for FCS until #3113 is fixed * fix build * use explicit version flag for FCS until #3113 is fixed * use WeakByteFile * add cache size parameter * add cache size parameter * fix build --- .../FSharp.Compiler.Service.Tests.fsproj | 2 +- fcs/README.md | 6 +- fcs/RELEASE_NOTES.md | 7 ++ fcs/fcs.props | 3 +- src/absil/ilread.fs | 97 ++++++++++--------- 5 files changed, 63 insertions(+), 52 deletions(-) diff --git a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 148b5f4dad63..88236b9dffcd 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -6,7 +6,7 @@ net46;netcoreapp2.0 - $(NoWarn);44; + $(NoWarn);44;75; true true false diff --git a/fcs/README.md b/fcs/README.md index d297185ee65d..5110d7cbcc86 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -60,9 +60,9 @@ which does things like: Yu can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... - .nuget\nuget.exe push release\fcs\FSharp.Compiler.Service.21.0.1.nupkg %APIKEY% -Source https://nuget.org - .nuget\nuget.exe push release\fcs\FSharp.Compiler.Service.MSBuild.v12.21.0.1.nupkg %APIKEY% -Source https://nuget.org - .nuget\nuget.exe push release\fcs\FSharp.Compiler.Service.ProjectCracker.21.0.1.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.2.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.22.0.2.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.22.0.2.nupkg %APIKEY% -Source https://nuget.org ### Use of Paket and FAKE diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index 59a8745a7e3f..df8f86645d2c 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,10 @@ +#### 22.0.2 + * Use correct version number in DLLs (needed until https://github.com/Microsoft/visualfsharp/issues/3113 is fixed) + +#### 22.0.1 + * Integrate visualfsharp master + * Includes recent memory usage reduction work for ByteFile and ILAttributes + #### 21.0.1 * Use new .NET SDK project files * FSharp.Compiler.Service nuget now uses net45 and netstandard2.0 diff --git a/fcs/fcs.props b/fcs/fcs.props index c3e2198b38ff..4a4dfbc007e1 100644 --- a/fcs/fcs.props +++ b/fcs/fcs.props @@ -3,7 +3,8 @@ - 21.0.1 + 22.0.2 + --version:$(VersionPrefix) $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index d9d66d2464d0..91290dddf879 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -33,9 +33,11 @@ open System.Reflection let checking = false let logging = false -let _ = if checking then dprintn "warning : Ilread.checking is on" +let _ = if checking then dprintn "warning : ILBinaryReader.checking is on" let noStableFileHeuristic = try (System.Environment.GetEnvironmentVariable("FSharp_NoStableFileHeuristic") <> null) with _ -> false let alwaysMemoryMapFSC = try (System.Environment.GetEnvironmentVariable("FSharp_AlwaysMemoryMapCommandLineCompiler") <> null) with _ -> false +let stronglyHeldReaderCacheSizeDefault = 30 +let stronglyHeldReaderCacheSize = try (match System.Environment.GetEnvironmentVariable("FSharp_StronglyHeldBinaryReaderCacheSize") with null -> stronglyHeldReaderCacheSizeDefault | s -> int32 s) with _ -> stronglyHeldReaderCacheSizeDefault let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x) @@ -346,7 +348,7 @@ type ByteFile(fileName: string, bytes:byte[]) = /// This is the default implementation used by F# Compiler Services when accessing "stable" binaries. It is not used /// by Visual Studio, where tryGetMetadataSnapshot provides a RawMemoryFile backed by Roslyn data. [] -type WeakByteFile(fileName: string) = +type WeakByteFile(fileName: string, chunk: (int * int) option) = do stats.weakByteFileCount <- stats.weakByteFileCount + 1 @@ -357,30 +359,29 @@ type WeakByteFile(fileName: string) = let weakBytes = new WeakReference (null) member __.FileName = fileName - /// Get the bytes for the file - member this.Get() = - let mutable tg = null - if not (weakBytes.TryGetTarget(&tg)) then - if FileSystem.GetLastWriteTimeShim(fileName) <> fileStamp then - errorR (Error (FSComp.SR.ilreadFileChanged fileName, range0)) - - tg <- FileSystem.ReadAllBytesShim fileName - weakBytes.SetTarget tg - tg + /// Get the bytes for the file interface BinaryFile with - override __.GetView() = - let mutable tg = null + + override this.GetView() = let strongBytes = + let mutable tg = null if not (weakBytes.TryGetTarget(&tg)) then if FileSystem.GetLastWriteTimeShim(fileName) <> fileStamp then - errorR (Error (FSComp.SR.ilreadFileChanged fileName, range0)) + error (Error (FSComp.SR.ilreadFileChanged fileName, range0)) + + let bytes = + match chunk with + | None -> FileSystem.ReadAllBytesShim fileName + | Some(start, length) -> File.ReadBinaryChunk (fileName, start, length) + + tg <- bytes + + weakBytes.SetTarget bytes - tg <- FileSystem.ReadAllBytesShim fileName - weakBytes.SetTarget tg tg - (ByteView(strongBytes) :> BinaryView) + (ByteView(strongBytes) :> BinaryView) let seekReadByte (mdv:BinaryView) addr = mdv.ReadByte addr @@ -3927,27 +3928,31 @@ type ILModuleReader(ilModule: ILModuleDef, ilAssemblyRefs: Lazy(0, areSimilar=(fun (x, y) -> x = y)) +type ILModuleReaderCacheKey = ILModuleReaderCacheKey of string * DateTime * ILScopeRef * bool * ReduceMemoryFlag * MetadataOnlyFlag +let ilModuleReaderCache = new AgedLookup(stronglyHeldReaderCacheSize, areSimilar=(fun (x, y) -> x = y)) let ilModuleReaderCacheLock = Lock() let stableFileHeuristicApplies fileName = not noStableFileHeuristic && try FileSystem.IsStableFileHeuristic fileName with _ -> false -let createByteFile opts fileName = +let createByteFileChunk opts fileName chunk = // If we're trying to reduce memory usage then we are willing to go back and re-read the binary, so we can use // a weakly-held handle to an array of bytes. if opts.reduceMemoryUsage = ReduceMemoryFlag.Yes && stableFileHeuristicApplies fileName then - WeakByteFile(fileName) :> BinaryFile + WeakByteFile(fileName, chunk) :> BinaryFile else - let bytes = FileSystem.ReadAllBytesShim(fileName) + let bytes = + match chunk with + | None -> FileSystem.ReadAllBytesShim fileName + | Some (start, length) -> File.ReadBinaryChunk(fileName, start, length) ByteFile(fileName, bytes) :> BinaryFile -let tryMemoryMap opts fileName = +let tryMemoryMapWholeFile opts fileName = let file = try MemoryMapFile.Create fileName :> BinaryFile with _ -> - createByteFile opts fileName + createByteFileChunk opts fileName None let disposer = { new IDisposable with member __.Dispose() = @@ -3963,17 +3968,16 @@ let OpenILModuleReaderFromBytes fileName bytes opts = let OpenILModuleReader fileName opts = // Pseudo-normalize the paths. - let ((_,writeStamp,_,_,_,_) as key), keyOk = + let (ILModuleReaderCacheKey (fullPath,writeStamp,_,_,_,_) as key), keyOk = try - (FileSystem.GetFullPathShim(fileName), - FileSystem.GetLastWriteTimeShim(fileName), - opts.ilGlobals.primaryAssemblyScopeRef, - opts.pdbPath.IsSome, - opts.reduceMemoryUsage, - opts.metadataOnly), true - with e -> - System.Diagnostics.Debug.Assert(false, sprintf "Failed to compute key in OpenILModuleReader cache for '%s'. Falling back to uncached." fileName) - ("", System.DateTime.UtcNow, ILScopeRef.Local, false, ReduceMemoryFlag.Yes, MetadataOnlyFlag.Yes), false + let fullPath = FileSystem.GetFullPathShim(fileName) + let writeTime = FileSystem.GetLastWriteTimeShim(fileName) + let key = ILModuleReaderCacheKey (fullPath, writeTime, opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbPath.IsSome, opts.reduceMemoryUsage, opts.metadataOnly) + key, true + with exn -> + System.Diagnostics.Debug.Assert(false, sprintf "Failed to compute key in OpenILModuleReader cache for '%s'. Falling back to uncached. Error = %s" fileName (exn.ToString())) + let fakeKey = ILModuleReaderCacheKey(fileName, System.DateTime.UtcNow, ILScopeRef.Local, false, ReduceMemoryFlag.Yes, MetadataOnlyFlag.Yes) + fakeKey, false let cacheResult = if keyOk then @@ -3999,30 +4003,29 @@ let OpenILModuleReader fileName opts = // See if tryGetMetadata gives us a BinaryFile for the metadata section alone. let mdfileOpt = - match opts.tryGetMetadataSnapshot (fileName, writeStamp) with - | Some (obj, start, len) -> Some (RawMemoryFile(fileName, obj, start, len) :> BinaryFile) + match opts.tryGetMetadataSnapshot (fullPath, writeStamp) with + | Some (obj, start, len) -> Some (RawMemoryFile(fullPath, obj, start, len) :> BinaryFile) | None -> None // For metadata-only, always use a temporary, short-lived PE file reader, preferably over a memory mapped file. // Then use the metadata blob as the long-lived memory resource. - let disposer, pefileEager = tryMemoryMap opts fileName + let disposer, pefileEager = tryMemoryMapWholeFile opts fullPath use _disposer = disposer - let (metadataPhysLoc, metadataSize, peinfo, pectxtEager, pevEager, _pdb) = openPEFileReader (fileName, pefileEager, None) + let (metadataPhysLoc, metadataSize, peinfo, pectxtEager, pevEager, _pdb) = openPEFileReader (fullPath, pefileEager, None) let mdfile = match mdfileOpt with | Some mdfile -> mdfile | None -> // If tryGetMetadata doesn't give anything, then just read the metadata chunk out of the binary - let bytes = File.ReadBinaryChunk (fileName, metadataPhysLoc, metadataSize) - ByteFile(fileName, bytes) :> BinaryFile + createByteFileChunk opts fullPath (Some (metadataPhysLoc, metadataSize)) - let ilModule, ilAssemblyRefs = openPEMetadataOnly (fileName, peinfo, pectxtEager, pevEager, mdfile, reduceMemoryUsage, opts.ilGlobals) + let ilModule, ilAssemblyRefs = openPEMetadataOnly (fullPath, peinfo, pectxtEager, pevEager, mdfile, reduceMemoryUsage, opts.ilGlobals) new ILModuleReader(ilModule, ilAssemblyRefs, ignore) else // If we are not doing metadata-only, then just go ahead and read all the bytes and hold them either strongly or weakly // depending on the heuristic - let pefile = createByteFile opts fileName - let ilModule, ilAssemblyRefs, _pdb = openPE (fileName, pefile, None, reduceMemoryUsage, opts.ilGlobals) + let pefile = createByteFileChunk opts fullPath None + let ilModule, ilAssemblyRefs, _pdb = openPE (fullPath, pefile, None, reduceMemoryUsage, opts.ilGlobals) new ILModuleReader(ilModule, ilAssemblyRefs, ignore) if keyOk then @@ -4042,14 +4045,14 @@ let OpenILModuleReader fileName opts = // multi-proc build. So use memory mapping, but only for stable files. Other files // fill use an in-memory ByteFile let _disposer, pefile = - if alwaysMemoryMapFSC || stableFileHeuristicApplies fileName then - tryMemoryMap opts fileName + if alwaysMemoryMapFSC || stableFileHeuristicApplies fullPath then + tryMemoryMapWholeFile opts fullPath else - let pefile = createByteFile opts fileName + let pefile = createByteFileChunk opts fullPath None let disposer = { new IDisposable with member __.Dispose() = () } disposer, pefile - let ilModule, ilAssemblyRefs, pdb = openPE (fileName, pefile, opts.pdbPath, reduceMemoryUsage, opts.ilGlobals) + let ilModule, ilAssemblyRefs, pdb = openPE (fullPath, pefile, opts.pdbPath, reduceMemoryUsage, opts.ilGlobals) let ilModuleReader = new ILModuleReader(ilModule, ilAssemblyRefs, (fun () -> ClosePdbReader pdb)) // Readers with PDB reader disposal logic don't go in the cache. Note the PDB reader is only used in static linking. From e703c49982ba1d3525fad95dfc6850b7da54a80f Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Tue, 27 Mar 2018 18:52:37 +0200 Subject: [PATCH 03/24] fix typos (#4630) --- fcs/README.md | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/fcs/README.md b/fcs/README.md index 5110d7cbcc86..ff53ba8ccd39 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -1,11 +1,11 @@ -# The FSharp.Compiler.Service components and nuget package +# The FSharp.Compiler.Service components and NuGet package -This directory contains the build, packaging, test and documentation-generation logic for the nuget package ``FSharp.Compiler.Service``. The source for this nuget +This directory contains the build, packaging, test and documentation-generation logic for the NuGet package ``FSharp.Compiler.Service``. The source for this NuGet package is in ``..\src``. -Basically we are packaging up the compiler as a DLL and publishing it as a nuget package. +Basically we are packaging up the compiler as a DLL and publishing it as a NuGet package. ## FSharp.Compiler.Service v. FSharp.Compiler.Private @@ -13,7 +13,7 @@ There are subtle differences between FSharp.Compiler.Service and FSharp.Compiler - FCS has a public API - FCS is built against **.NET 4.5** and **FSharp.Core 4.0.0.0** to give broader reach -- FCS has a Nuget package +- FCS has a NuGet package - FCS has a .NET Standard 1.6 version in the nuget package - FCS testing also tests the "Project Cracker" (see below) - FCS doesn't add the System.ValueTuple.dll reference by default, see ``#if COMPILER_SERVICE_AS_DLL`` in compiler codebase @@ -57,7 +57,7 @@ which does things like: ### Manual push of packages -Yu can push the packages if you have permissions, either automatically using ``build Release`` or manually +You can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.2.nupkg %APIKEY% -Source https://nuget.org @@ -67,7 +67,7 @@ Yu can push the packages if you have permissions, either automatically using ``b ### Use of Paket and FAKE -Paket is only used to get fake and formating tools. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. +Paket is only used to get FAKE and FSharp.Formatting tools. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. FAKE is only used to run build.fsx. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. @@ -83,7 +83,7 @@ Testing reuses the test files from ..\tests\service which were are also FCS test Output is in ``docs``. In the ``FSharp.Compiler.Service`` repo this is checked in and hosted as http://fsharp.github.io/FSharp.Compiler.Service. -## The two other nuget packages +## The two other NuGet packages It also contains both the source, build, packaging and test logic for From 4c77bdde49376b590a20180d83e3effced5173a6 Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Tue, 27 Mar 2018 14:15:10 -0700 Subject: [PATCH 04/24] also create the Microsoft.FSharp.Compiler.*.symbols.nupkg --- PublishToBlob.proj | 1 + .../FSharp.Compiler.Template.nuget.targets | 4 ++-- .../Microsoft.FSharp.Compiler.nuspec | 11 ++++++++++- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/PublishToBlob.proj b/PublishToBlob.proj index 6d71be84df3f..ba08968773a6 100644 --- a/PublishToBlob.proj +++ b/PublishToBlob.proj @@ -16,6 +16,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.Template.nuget.targets b/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.Template.nuget.targets index d4a0997e59b7..02ffc4a07e5d 100644 --- a/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.Template.nuget.targets +++ b/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.Template.nuget.targets @@ -40,8 +40,8 @@ - - + + diff --git a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec index c70df6f21e58..39ebbbd9b10b 100644 --- a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec +++ b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec @@ -56,19 +56,28 @@ tools, build and runtime/native make unnecessary copies. this approach gives a very small deployment. Which is kind of necessary. --> + + + + + + + + + - + From ff078e94deff66e548efb668465fcdd601cc158d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 28 Mar 2018 15:49:03 +0100 Subject: [PATCH 05/24] Add entity.DeclaringEntity to F# Compiler Service (#4633) * Add DeclaringEntity * extend tests to cover namespaces * extend tests to cover namespaces * build on Mono 5.10 * bump FCS version * various comments and debugging improvements * code review --- fcs/README.md | 6 +- fcs/RELEASE_NOTES.md | 3 + fcs/fcs.props | 2 +- src/absil/il.fs | 55 ++- src/absil/il.fsi | 42 +- src/fsharp/CompileOps.fs | 234 +++++------ src/fsharp/CompileOps.fsi | 12 +- src/fsharp/FSharp.Core/list.fs | 2 +- src/fsharp/FindUnsolved.fs | 2 +- src/fsharp/IlxGen.fs | 7 +- src/fsharp/InnerLambdasToTopLevelFuncs.fs | 4 +- src/fsharp/NicePrint.fs | 6 +- src/fsharp/Optimizer.fs | 4 +- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/TastOps.fs | 10 +- src/fsharp/TypeChecker.fs | 2 +- src/fsharp/TypeChecker.fsi | 2 +- src/fsharp/fsi/fsi.fs | 12 +- src/fsharp/service/IncrementalBuild.fs | 32 +- src/fsharp/service/IncrementalBuild.fsi | 5 +- src/fsharp/service/service.fs | 135 +++--- src/fsharp/symbols/Exprs.fs | 20 +- src/fsharp/symbols/Exprs.fsi | 4 +- src/fsharp/symbols/Symbols.fs | 303 ++++++++------ src/fsharp/symbols/Symbols.fsi | 63 +-- src/fsharp/tast.fs | 489 +++++++++++++--------- src/scripts/scriptlib.fsx | 2 +- tests/service/ProjectAnalysisTests.fs | 93 +++- 28 files changed, 906 insertions(+), 647 deletions(-) diff --git a/fcs/README.md b/fcs/README.md index ff53ba8ccd39..8f86342739ea 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -60,9 +60,9 @@ which does things like: You can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.2.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.22.0.2.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.22.0.2.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.3.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.22.0.3.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.22.0.3.nupkg %APIKEY% -Source https://nuget.org ### Use of Paket and FAKE diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index df8f86645d2c..67ac7bcc6b92 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,6 @@ +#### 22.0.3 + * [Add entity.DeclaringEntity](https://github.com/Microsoft/visualfsharp/pull/4633), [FCS feature request](https://github.com/fsharp/FSharp.Compiler.Service/issues/830) + #### 22.0.2 * Use correct version number in DLLs (needed until https://github.com/Microsoft/visualfsharp/issues/3113 is fixed) diff --git a/fcs/fcs.props b/fcs/fcs.props index 4a4dfbc007e1..8c9869c4fc19 100644 --- a/fcs/fcs.props +++ b/fcs/fcs.props @@ -3,7 +3,7 @@ - 22.0.2 + 22.0.3 --version:$(VersionPrefix) diff --git a/src/absil/il.fs b/src/absil/il.fs index ce8ee4065ef9..32e1812c5286 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -408,8 +408,6 @@ type ILAssemblyRef(data) = ILAssemblyRef.Create(aname.Name,None,publicKey,retargetable,version,locale) - - member aref.QualifiedName = let b = new System.Text.StringBuilder(100) let add (s:string) = (b.Append(s) |> ignore) @@ -478,13 +476,6 @@ type ILScopeRef = member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" member scoref.QualifiedName = - match scoref with - | ILScopeRef.Local -> "" - | ILScopeRef.Module mref -> "module "^mref.Name - | ILScopeRef.Assembly aref when aref.Name = "mscorlib" -> "" - | ILScopeRef.Assembly aref -> aref.QualifiedName - - member scoref.QualifiedNameWithNoShortPrimaryAssembly = match scoref with | ILScopeRef.Local -> "" | ILScopeRef.Module mref -> "module "+mref.Name @@ -602,18 +593,12 @@ type ILTypeRef = member tref.BasicQualifiedName = (String.concat "+" (tref.Enclosing @ [ tref.Name ] )).Replace(",", @"\,") - member tref.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = - let sco = tref.Scope.QualifiedNameWithNoShortPrimaryAssembly - if sco = "" then basic else String.concat ", " [basic;sco] - - member tref.QualifiedNameWithNoShortPrimaryAssembly = - tref.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(tref.BasicQualifiedName) - - member tref.QualifiedName = - let basic = tref.BasicQualifiedName + member tref.AddQualifiedNameExtension(basic) = let sco = tref.Scope.QualifiedName if sco = "" then basic else String.concat ", " [basic;sco] + member tref.QualifiedName = + tref.AddQualifiedNameExtension(tref.BasicQualifiedName) override x.ToString() = x.FullName @@ -624,22 +609,30 @@ and { tspecTypeRef: ILTypeRef; /// The type instantiation if the type is generic. tspecInst: ILGenericArgs } + member x.TypeRef=x.tspecTypeRef + member x.Scope=x.TypeRef.Scope + member x.Enclosing=x.TypeRef.Enclosing + member x.Name=x.TypeRef.Name + member x.GenericArgs=x.tspecInst + static member Create(tref,inst) = { tspecTypeRef =tref; tspecInst=inst } + override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>" + member x.BasicQualifiedName = let tc = x.TypeRef.BasicQualifiedName if isNil x.GenericArgs then tc else - tc + "[" + String.concat "," (x.GenericArgs |> List.map (fun arg -> "[" + arg.QualifiedNameWithNoShortPrimaryAssembly + "]")) + "]" + tc + "[" + String.concat "," (x.GenericArgs |> List.map (fun arg -> "[" + arg.QualifiedName + "]")) + "]" - member x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = - x.TypeRef.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) + member x.AddQualifiedNameExtension(basic) = + x.TypeRef.AddQualifiedNameExtension(basic) member x.FullName=x.TypeRef.FullName @@ -666,19 +659,19 @@ and [] | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - member x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = + member x.AddQualifiedNameExtension(basic) = match x with | ILType.TypeVar _n -> basic - | ILType.Modified(_,_ty1,ty2) -> ty2.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) - | ILType.Array (ILArrayShape(_s),ty) -> ty.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) - | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) + | ILType.Modified(_,_ty1,ty2) -> ty2.AddQualifiedNameExtension(basic) + | ILType.Array (ILArrayShape(_s),ty) -> ty.AddQualifiedNameExtension(basic) + | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtension(basic) | ILType.Void -> failwith "void" | ILType.Ptr _ty -> failwith "unexpected pointer type" | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - member x.QualifiedNameWithNoShortPrimaryAssembly = - x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(x.BasicQualifiedName) + member x.QualifiedName = + x.AddQualifiedNameExtension(x.BasicQualifiedName) member x.TypeSpec = match x with @@ -3301,7 +3294,7 @@ let rec encodeCustomAttrElemType x = | ILType.Boxed tspec when tspec.Name = tname_String -> [| et_STRING |] | ILType.Boxed tspec when tspec.Name = tname_Object -> [| 0x51uy |] | ILType.Boxed tspec when tspec.Name = tname_Type -> [| 0x50uy |] - | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedNameWithNoShortPrimaryAssembly) + | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType) | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type" @@ -3372,8 +3365,8 @@ let rec encodeCustomAttrPrimValue ilg c = | ILAttribElem.UInt64 x -> u64AsBytes x | ILAttribElem.Single x -> ieee32AsBytes x | ILAttribElem.Double x -> ieee64AsBytes x - | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedNameWithNoShortPrimaryAssembly - | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedNameWithNoShortPrimaryAssembly + | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedName + | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedName | ILAttribElem.Array (_,elems) -> [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue ilg elem |] @@ -3427,7 +3420,7 @@ let mkPermissionSet (ilg: ILGlobals) (action,attributes: list<(ILTypeRef * (stri [| yield (byte '.'); yield! z_unsigned_int attributes.Length; for (tref:ILTypeRef,props) in attributes do - yield! encodeCustomAttrString tref.QualifiedNameWithNoShortPrimaryAssembly + yield! encodeCustomAttrString tref.QualifiedName let bytes = [| yield! z_unsigned_int props.Length; for (nm,typ,value) in props do diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 33b077e1976e..621bfb1eff12 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -184,15 +184,12 @@ type ILTypeRef = member QualifiedName: string -#if !NO_EXTENSIONTYPING - member QualifiedNameWithNoShortPrimaryAssembly: string -#endif - interface System.IComparable /// Type specs and types. [] type ILTypeSpec = + /// Create an ILTypeSpec. static member Create: typeRef:ILTypeRef * instantiation:ILGenericArgs -> ILTypeSpec /// Which type is being referred to? @@ -200,10 +197,19 @@ type ILTypeSpec = /// The type instantiation if the type is generic, otherwise empty member GenericArgs: ILGenericArgs + + /// Where is the type, i.e. is it in this module, in another module in this assembly or in another assembly? member Scope: ILScopeRef + + /// The list of enclosing type names for a nested type. If non-nil then the first of these also contains the namespace. member Enclosing: string list + + /// The name of the type. This also contains the namespace if Enclosing is empty. member Name: string + + /// The name of the type in the assembly using the '.' notation for nested types. member FullName: string + interface System.IComparable and @@ -244,13 +250,20 @@ and ILType member TypeSpec: ILTypeSpec + member Boxity: ILBoxity + member TypeRef: ILTypeRef + member IsNominal: bool + member GenericArgs: ILGenericArgs + member IsTyvar: bool + member BasicQualifiedName: string - member QualifiedNameWithNoShortPrimaryAssembly: string + + member QualifiedName: string and [] ILCallingSignature = @@ -271,13 +284,21 @@ type ILMethodRef = static member Create: enclosingTypeRef: ILTypeRef * callingConv: ILCallingConv * name: string * genericArity: int * argTypes: ILTypes * returnType: ILType -> ILMethodRef member DeclaringTypeRef: ILTypeRef + member CallingConv: ILCallingConv + member Name: string + member GenericArity: int + member ArgCount: int + member ArgTypes: ILTypes + member ReturnType: ILType + member CallingSignature: ILCallingSignature + interface System.IComparable /// Formal identities of fields. @@ -295,13 +316,21 @@ type ILMethodSpec = static member Create: ILType * ILMethodRef * ILGenericArgs -> ILMethodSpec member MethodRef: ILMethodRef + member DeclaringType: ILType + member GenericArgs: ILGenericArgs + member CallingConv: ILCallingConv + member GenericArity: int + member Name: string + member FormalArgTypes: ILTypes + member FormalReturnType: ILType + interface System.IComparable /// Field specs. The data given for a ldfld, stfld etc. instruction. @@ -311,8 +340,11 @@ type ILFieldSpec = DeclaringType: ILType } member DeclaringTypeRef: ILTypeRef + member Name: string + member FormalType: ILType + member ActualType: ILType /// ILCode labels. In structured code each code label refers to a basic block somewhere in the code of the method. diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 7c0c6220f106..144fd3a65c03 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5326,7 +5326,6 @@ let CheckSimulateException(tcConfig:TcConfig) = type RootSigs = Zmap type RootImpls = Zset -type TypecheckerSigsAndImpls = RootSigsAndImpls of RootSigs * RootImpls * ModuleOrNamespaceType * ModuleOrNamespaceType let qnameOrder = Order.orderBy (fun (q:QualifiedNameOfFile) -> q.Text) @@ -5337,17 +5336,25 @@ type TcState = tcsTcSigEnv: TcEnv tcsTcImplEnv: TcEnv tcsCreatesGeneratedProvidedTypes: bool - /// The accumulated results of type checking for this assembly - tcsRootSigsAndImpls : TypecheckerSigsAndImpls } + tcsRootSigs: RootSigs + tcsRootImpls: RootImpls + tcsCcuSig: ModuleOrNamespaceType } + member x.NiceNameGenerator = x.tcsNiceNameGen + member x.TcEnvFromSignatures = x.tcsTcSigEnv + member x.TcEnvFromImpls = x.tcsTcImplEnv + member x.Ccu = x.tcsCcu + member x.CreatesGeneratedProvidedTypes = x.tcsCreatesGeneratedProvidedTypes - member x.PartialAssemblySignature = - let (RootSigsAndImpls(_rootSigs, _rootImpls, _allSigModulTyp, allImplementedSigModulTyp)) = x.tcsRootSigsAndImpls - allImplementedSigModulTyp + // Assem(a.fsi + b.fsi + c.fsi) (after checking implementation file ) + member x.CcuType = x.tcsCcuType + + // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) + member x.CcuSig = x.tcsCcuSig member x.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) = { x with tcsTcSigEnv = tcEnvAtEndOfLastInput @@ -5385,133 +5392,127 @@ let GetInitialTcState(m, ccuName, tcConfig:TcConfig, tcGlobals, tcImports:TcImpo if tcConfig.compilingFslib then tcGlobals.fslibCcu.Fixup(ccu) - let rootSigs = Zmap.empty qnameOrder - let rootImpls = Zset.empty qnameOrder - let allSigModulTyp = NewEmptyModuleOrNamespaceType Namespace - let allImplementedSigModulTyp = NewEmptyModuleOrNamespaceType Namespace { tcsCcu= ccu tcsCcuType=ccuType tcsNiceNameGen=niceNameGen tcsTcSigEnv=tcEnv0 tcsTcImplEnv=tcEnv0 tcsCreatesGeneratedProvidedTypes=false - tcsRootSigsAndImpls = RootSigsAndImpls (rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) } + tcsRootSigs = Zmap.empty qnameOrder + tcsRootImpls = Zset.empty qnameOrder + tcsCcuSig = NewEmptyModuleOrNamespaceType Namespace } + /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEventually - (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, - tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = - eventually { - try - let! ctok = Eventually.token - RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - - CheckSimulateException(tcConfig) - let (RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp)) = tcState.tcsRootSigsAndImpls - let m = inp.Range - let amap = tcImports.GetImportMap() - let! (topAttrs, implFiles, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) = - eventually { - match inp with - | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> - - // Check if we've seen this top module signature before. - if Zmap.mem qualNameOfFile rootSigs then - errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) +let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = - // Check if the implementation came first in compilation order - if Zset.contains qualNameOfFile rootImpls then - errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) + eventually { + try + let! ctok = Eventually.token + RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - // Typecheck the signature file - let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = - TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file + CheckSimulateException(tcConfig) - let rootSigs = Zmap.add qualNameOfFile sigFileType rootSigs + let m = inp.Range + let amap = tcImports.GetImportMap() + match inp with + | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> + + // Check if we've seen this top module signature before. + if Zmap.mem qualNameOfFile tcState.tcsRootSigs then + errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) - // Open the prefixPath for fsi.exe - let tcEnv = - match prefixPathOpt with - | None -> tcEnv - | Some prefixPath -> - let m = qualNameOfFile.Range - TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + // Check if the implementation came first in compilation order + if Zset.contains qualNameOfFile tcState.tcsRootImpls then + errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) - let res = (EmptyTopAttrs, None, tcEnv, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType, createsGeneratedProvidedTypes) - return res + // Typecheck the signature file + let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = + TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file - | ParsedInput.ImplFile (ParsedImplFileInput(filename, _, qualNameOfFile, _, _, _, _) as file) -> - - // Check if we've got an interface for this fragment - let rootSigOpt = rootSigs.TryFind(qualNameOfFile) + let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs - if verbose then dprintf "ParsedInput.ImplFile, nm = %s, qualNameOfFile = %s, ?rootSigOpt = %b\n" filename qualNameOfFile.Text (Option.isSome rootSigOpt) + // Add the signature to the signature env (unless it had an explicit signature) + let ccuSigForFile = CombineCcuContentFragments m [sigFileType; tcState.tcsCcuSig] + + // Open the prefixPath for fsi.exe + let tcEnv = + match prefixPathOpt with + | None -> tcEnv + | Some prefixPath -> + let m = qualNameOfFile.Range + TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + + let tcState = + { tcState with + tcsTcSigEnv=tcEnv + tcsTcImplEnv=tcState.tcsTcImplEnv + tcsRootSigs=rootSigs + tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes} + + return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState + + | ParsedInput.ImplFile (ParsedImplFileInput(_, _, qualNameOfFile, _, _, _, _) as file) -> + + // Check if we've got an interface for this fragment + let rootSigOpt = tcState.tcsRootSigs.TryFind(qualNameOfFile) - // Check if we've already seen an implementation for this fragment - if Zset.contains qualNameOfFile rootImpls then + // Check if we've already seen an implementation for this fragment + if Zset.contains qualNameOfFile tcState.tcsRootImpls then errorR(Error(FSComp.SR.buildImplementationAlreadyGiven(qualNameOfFile.Text), m)) - let tcImplEnv = tcState.tcsTcImplEnv + let tcImplEnv = tcState.tcsTcImplEnv - // Typecheck the implementation file - let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file + // Typecheck the implementation file + let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file - let hadSig = Option.isSome rootSigOpt - let implFileSigType = SigTypeOfImplFile implFile + let hadSig = rootSigOpt.IsSome + let implFileSigType = SigTypeOfImplFile implFile - if verbose then dprintf "done TypeCheckOneImplFile...\n" - let rootImpls = Zset.add qualNameOfFile rootImpls + let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls - // Only add it to the environment if it didn't have a signature - let m = qualNameOfFile.Range + // Only add it to the environment if it didn't have a signature + let m = qualNameOfFile.Range - // Add the implementation as to the implementation env - let tcImplEnv = AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType + // Add the implementation as to the implementation env + let tcImplEnv = AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType - // Add the implementation as to the signature env (unless it had an explicit signature) - let tcSigEnv = - if hadSig then tcState.tcsTcSigEnv - else AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType + // Add the implementation as to the signature env (unless it had an explicit signature) + let tcSigEnv = + if hadSig then tcState.tcsTcSigEnv + else AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType - // Open the prefixPath for fsi.exe (tcImplEnv) - let tcImplEnv = - match prefixPathOpt with - | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath - | _ -> tcImplEnv - - // Open the prefixPath for fsi.exe (tcSigEnv) - let tcSigEnv = - match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath - | _ -> tcSigEnv - - let allImplementedSigModulTyp = CombineCcuContentFragments m [implFileSigType; allImplementedSigModulTyp] - - // Add it to the CCU - let ccuType = - // The signature must be reestablished. - // [CHECK: Why? This seriously degraded performance] - NewCcuContents ILScopeRef.Local m tcState.tcsCcu.AssemblyName allImplementedSigModulTyp - - if verbose then dprintf "done TypeCheckOneInputEventually...\n" - - let topSigsAndImpls = RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) - let res = (topAttrs, Some implFile, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) - return res } + // Open the prefixPath for fsi.exe (tcImplEnv) + let tcImplEnv = + match prefixPathOpt with + | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath + | _ -> tcImplEnv + + // Open the prefixPath for fsi.exe (tcSigEnv) + let tcSigEnv = + match prefixPathOpt with + | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath + | _ -> tcSigEnv + + let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] + + let ccuSigForFile = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig] + + let tcState = + { tcState with + tcsTcSigEnv=tcSigEnv + tcsTcImplEnv=tcImplEnv + tcsRootImpls=rootImpls + tcsCcuSig=ccuSig + tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes } + return (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile), tcState - return (tcEnvAtEnd, topAttrs, implFiles), - { tcState with - tcsCcuType=ccuType - tcsTcSigEnv=tcSigEnv - tcsTcImplEnv=tcImplEnv - tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes - tcsRootSigsAndImpls = topSigsAndImpls } - with e -> - errorRecovery e range0 - return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None), tcState - } + with e -> + errorRecovery e range0 + return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState + } /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = @@ -5523,19 +5524,12 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = - let tcEnvsAtEndFile, topAttrs, implFiles = List.unzip3 results - + let tcEnvsAtEndFile, topAttrs, implFiles, ccuSigsForFiles = List.unzip4 results let topAttrs = List.foldBack CombineTopAttrs topAttrs EmptyTopAttrs let implFiles = List.choose id implFiles // This is the environment required by fsi.exe when incrementally adding definitions let tcEnvAtEndOfLastFile = (match tcEnvsAtEndFile with h :: _ -> h | _ -> tcState.TcEnvFromSignatures) - - (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState - -/// Check multiple files (or one interactive entry into F# Interactive) -let TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) - TypeCheckMultipleInputsFinish(results, tcState) + (tcEnvAtEndOfLastFile, topAttrs, implFiles, ccuSigsForFiles), tcState let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { @@ -5545,18 +5539,18 @@ let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcI let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = // Publish the latest contents to the CCU - tcState.tcsCcu.Deref.Contents <- tcState.tcsCcuType + tcState.tcsCcu.Deref.Contents <- NewCcuContents ILScopeRef.Local range0 tcState.tcsCcu.AssemblyName tcState.tcsCcuSig // Check all interfaces have implementations - let (RootSigsAndImpls(rootSigs, rootImpls, _, _)) = tcState.tcsRootSigsAndImpls - rootSigs |> Zmap.iter (fun qualNameOfFile _ -> - if not (Zset.contains qualNameOfFile rootImpls) then + tcState.tcsRootSigs |> Zmap.iter (fun qualNameOfFile _ -> + if not (Zset.contains qualNameOfFile tcState.tcsRootImpls) then errorR(Error(FSComp.SR.buildSignatureWithoutImplementation(qualNameOfFile.Text), qualNameOfFile.Range))) tcState, declaredImpls let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState = TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 0b404712662e..50f2add519e8 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -704,8 +704,10 @@ type TcState = /// Get the typing environment implied by the set of implementation files checked so far member TcEnvFromImpls: TcEnv - /// The inferred contents of the assembly, containing the signatures of all implemented files. - member PartialAssemblySignature: ModuleOrNamespaceType + + /// The inferred contents of the assembly, containing the signatures of all files. + // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) + member CcuSig: ModuleOrNamespaceType member NextStateAfterIncrementalFragment: TcEnv -> TcState @@ -718,10 +720,10 @@ val GetInitialTcState: /// Check one input, returned as an Eventually computation val TypeCheckOneInputEventually : checkForErrors:(unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput - -> Eventually<(TcEnv * TopAttribs * TypedImplFile option) * TcState> + -> Eventually<(TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType) * TcState> /// Finish the checking of multiple inputs -val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T option) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState +val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T option * 'U) list * TcState -> (TcEnv * TopAttribs * 'T list * 'U list) * TcState /// Finish the checking of a closed set of inputs val TypeCheckClosedInputSetFinish: TypedImplFile list * TcState -> TcState * TypedImplFile list @@ -732,7 +734,7 @@ val TypeCheckClosedInputSet: CompilationThreadToken * checkForErrors: (unit -> b /// Check a single input and finish the checking val TypeCheckOneInputAndFinishEventually : checkForErrors: (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput - -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState> + -> Eventually<(TcEnv * TopAttribs * TypedImplFile list * ModuleOrNamespaceType list) * TcState> /// Indicates if we should report a warning val ReportWarning: FSharpErrorSeverityOptions -> PhasedDiagnostic -> bool diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index 3e9a75e3ccfc..aea7ef55ea9c 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -415,7 +415,7 @@ namespace Microsoft.FSharp.Collections let filter predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list [] - let except itemsToExclude list = + let except (itemsToExclude: seq<'T>) list = checkNonNull "itemsToExclude" itemsToExclude match list with | [] -> list diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index f207262e930a..aa144dc49eeb 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -218,7 +218,7 @@ let accTycons cenv env tycons = List.iter (accTycon cenv env) tycons let rec accModuleOrNamespaceExpr cenv env x = match x with - | ModuleOrNamespaceExprWithSig(_mty,def,_m) -> accModuleOrNamespaceDef cenv env def + | ModuleOrNamespaceExprWithSig(_mty, def, _m) -> accModuleOrNamespaceDef cenv env def and accModuleOrNamespaceDefs cenv env x = List.iter (accModuleOrNamespaceDef cenv env) x diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 493b9c3c9642..56325f5a6f24 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -970,7 +970,7 @@ and AddBindingsForModuleDef allocVal cloc eenv x = allocVal cloc bind.Var eenv | TMDefDo _ -> eenv - | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp,_,_)) -> + | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> AddBindingsForLocalModuleType allocVal cloc eenv mtyp | TMDefs(mdefs) -> AddBindingsForModuleDefs allocVal cloc eenv mdefs @@ -1001,8 +1001,7 @@ let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:ImportMap, isIncrementa let cloc = { cloc with clocTopImplQualifiedName = qname.Text } if isIncrementalFragment then match mexpr with - | ModuleOrNamespaceExprWithSig(_,mdef,_) -> AddBindingsForModuleDef allocVal cloc eenv mdef - (* | ModuleOrNamespaceExprWithSig(mtyp,_,m) -> error(Error("don't expect inner defs to have a constraint",m)) *) + | ModuleOrNamespaceExprWithSig(_, mdef, _) -> AddBindingsForModuleDef allocVal cloc eenv mdef else AddBindingsForLocalModuleType allocVal cloc eenv mexpr.Type) @@ -5782,7 +5781,7 @@ and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attr and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = - let (ModuleOrNamespaceExprWithSig(mty,def,_)) = x + let (ModuleOrNamespaceExprWithSig(mty, def, _)) = x // REVIEW: the scopeMarks are used for any shadow locals we create for the module bindings // We use one scope for all the bindings in the module, which makes them all appear with their "default" values // rather than incrementally as we step through the initializations in the module. This is a little unfortunate diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index f8fc13544949..0828e1cd0fbf 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -1249,9 +1249,9 @@ module Pass4_RewriteAssembly = and TransValBindings penv z binds = List.mapFold (TransValBinding penv) z binds and TransModuleExpr penv z x = match x with - | ModuleOrNamespaceExprWithSig(mty,def,m) -> + | ModuleOrNamespaceExprWithSig(mty, def, m) -> let def,z = TransModuleDef penv z def - ModuleOrNamespaceExprWithSig(mty,def,m),z + ModuleOrNamespaceExprWithSig(mty, def, m),z and TransModuleDefs penv z x = List.mapFold (TransModuleDef penv) z x and TransModuleDef penv (z: RewriteState) x : ModuleOrNamespaceExpr * RewriteState = diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index e3ad74ad0d31..f31fc657cc45 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1824,11 +1824,11 @@ module private InferredSigPrinting = | TMDefLet _ -> true | TMDefDo _ -> true | TMDefs defs -> defs |> List.exists isConcreteNamespace - | TMAbstract(ModuleOrNamespaceExprWithSig(_,def,_)) -> isConcreteNamespace def + | TMAbstract(ModuleOrNamespaceExprWithSig(_, def, _)) -> isConcreteNamespace def - let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_,def,_)) = imdefL denv def + let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_, def, _)) = imdefL denv def - and imexprL denv (ModuleOrNamespaceExprWithSig(mty,def,m)) = imexprLP denv (ModuleOrNamespaceExprWithSig(mty,def,m)) + and imexprL denv (ModuleOrNamespaceExprWithSig(mty, def, m)) = imexprLP denv (ModuleOrNamespaceExprWithSig(mty, def, m)) and imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 7ce763fede80..308736ddbd42 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -3154,7 +3154,7 @@ and OptimizeModuleDefs cenv (env, bindInfosColl) defs = let defs, minfos = List.unzip defs (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) -and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty, _, _) as mexpr), hasExplicitEntryPoint, isScript)) = +and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, mexpr, hasExplicitEntryPoint, isScript)) = let env, mexpr', minfo = match mexpr with // FSI: FSI compiles everything as if you're typing incrementally into one module @@ -3170,7 +3170,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn let env = { env with localExternalVals=env.localExternalVals.MarkAsCollapsible() } // take the chance to flatten to a dictionary env, mexpr', minfo - let hidden = ComputeHidingInfoAtAssemblyBoundary mty hidden + let hidden = ComputeHidingInfoAtAssemblyBoundary mexpr.Type hidden let minfo = AbstractLazyModulInfoByHiding true hidden minfo env, TImplFile(qname, pragmas, mexpr', hasExplicitEntryPoint, isScript), minfo, hidden diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index c22fb3f4098f..1d722b3e4585 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1657,7 +1657,7 @@ let CheckEntityDefns cenv env tycons = let rec CheckModuleExpr cenv env x = match x with - | ModuleOrNamespaceExprWithSig(mty,def,_) -> + | ModuleOrNamespaceExprWithSig(mty, def, _) -> let (rpi,mhi) = ComputeRemappingFromImplementationToSignature cenv.g def mty let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi,mhi) :: env.sigToImplRemapInfo } CheckDefnInModule cenv env def diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 31f0b9790d90..25a2ac7b9c1d 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -3692,6 +3692,7 @@ let wrapModuleOrNamespaceExprInNamespace (id :Ident) cpath mexpr = // cleanup: make this a property let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _)) = mexpr.Type + //-------------------------------------------------------------------------- // Data structures representing what gets hidden and what gets remapped (i.e. renamed or alpha-converted) // when a module signature is applied to a module. @@ -5087,12 +5088,12 @@ and allValsOfModDef mdef = | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allValsOfModuleOrNamespaceTy mty } -and remapAndBindModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = +and remapAndBindModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef let mty, tmenv = copyAndRemapAndBindModTy g compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m), tmenv -and remapModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = +and remapModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef let mty = remapModTy g compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m) @@ -5124,7 +5125,7 @@ and remapAndRenameModDef g compgen tmenv mdef = let defs = remapAndRenameModDefs g compgen tmenv defs TMDefs defs | TMAbstract mexpr -> - let mexpr = remapModExpr g compgen tmenv mexpr + let mexpr = remapModuleOrNamespaceExprWithSig g compgen tmenv mexpr TMAbstract mexpr and remapAndRenameModBind g compgen tmenv x = @@ -5139,7 +5140,7 @@ and remapAndRenameModBind g compgen tmenv x = ModuleOrNamespaceBinding.Module(mspec, def) and remapImplFile g compgen tmenv mv = - mapAccImplFile (remapAndBindModExpr g compgen) tmenv mv + mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig g compgen) tmenv mv let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst let copyExpr g compgen e = remapExpr g compgen Remap.Empty e @@ -7709,7 +7710,6 @@ and rewriteObjExprInterfaceImpl env (ty, overrides) = and rewriteModuleOrNamespaceExpr env x = match x with - (* | ModuleOrNamespaceExprWithSig(mty, e, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceExpr env e, m) *) | ModuleOrNamespaceExprWithSig(mty, def, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceDef env def, m) and rewriteModuleOrNamespaceDefs env x = List.map (rewriteModuleOrNamespaceDef env) x diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index eb3e39783a5e..a18f6f5f720b 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -17166,7 +17166,7 @@ let TypeCheckOneImplFile let implFile = TImplFile(qualNameOfFile, scopedPragmas, implFileExprAfterSig, hasExplicitEntryPoint, isScript) - return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes) + return (topAttrs, implFile, implFileTypePriorToSig, envAtEnd, cenv.createsGeneratedProvidedTypes) } diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 448ba2cd6e4f..045c1e8437c5 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -43,7 +43,7 @@ val TypeCheckOneImplFile : -> TcEnv -> Tast.ModuleOrNamespaceType option -> ParsedImplFileInput - -> Eventually + -> Eventually val TypeCheckOneSigFile : TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 6b662c12af01..bc40ac47acfd 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1162,7 +1162,7 @@ type internal FsiDynamicCompiler // Find all new declarations the EvaluationListener try - let contents = FSharpAssemblyContents(tcGlobals, tcState.Ccu, tcImports, declaredImpls) + let contents = FSharpAssemblyContents(tcGlobals, tcState.Ccu, Some tcState.CcuSig, tcImports, declaredImpls) let contentFile = contents.ImplementationFiles.[0] // Skip the "FSI_NNNN" match contentFile.Declarations with @@ -1177,16 +1177,16 @@ type internal FsiDynamicCompiler | Item.Value vref -> let optValue = newState.ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext(newState.emEnv), vref.Deref) match optValue with - | Some (res, typ) -> Some(FsiValue(res, typ, FSharpType(tcGlobals, newState.tcState.Ccu, newState.tcImports, vref.Type))) + | Some (res, typ) -> Some(FsiValue(res, typ, FSharpType(tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, vref.Type))) | None -> None | _ -> None - let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcImports, v.Item) + let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, v.Item) let symbolUse = FSharpSymbolUse(tcGlobals, newState.tcState.TcEnvFromImpls.DisplayEnv, symbol, ItemOccurence.Binding, v.DeclarationLocation) fsi.TriggerEvaluation (fsiValueOpt, symbolUse, decl) | FSharpImplementationFileDeclaration.Entity (e,_) -> // Report a top-level module or namespace definition - let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcImports, e.Item) + let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, e.Item) let symbolUse = FSharpSymbolUse(tcGlobals, newState.tcState.TcEnvFromImpls.DisplayEnv, symbol, ItemOccurence.Binding, e.DeclarationLocation) fsi.TriggerEvaluation (None, symbolUse, decl) | FSharpImplementationFileDeclaration.InitAction _ -> @@ -1224,7 +1224,7 @@ type internal FsiDynamicCompiler // let optValue = istate.ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext(istate.emEnv), vref.Deref); match optValue with - | Some (res, typ) -> istate, Completed(Some(FsiValue(res, typ, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcImports, vref.Type)))) + | Some (res, typ) -> istate, Completed(Some(FsiValue(res, typ, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, vref.Type)))) | _ -> istate, Completed None // Return the interactive state. @@ -1349,7 +1349,7 @@ type internal FsiDynamicCompiler } member __.CurrentPartialAssemblySignature(istate) = - FSharpAssemblySignature(istate.tcGlobals, istate.tcState.Ccu, istate.tcImports, None, istate.tcState.PartialAssemblySignature) + FSharpAssemblySignature(istate.tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, None, istate.tcState.CcuSig) member __.FormatValue(obj:obj, objTy) = valuePrinter.FormatValue(obj, objTy) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index f1977599a27b..494ad478f3db 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1037,7 +1037,9 @@ type TypeCheckAccumulator = topAttribs:TopAttribs option /// Result of checking most recent file, if any - lastestTypedImplFile:TypedImplFile option + latestImplFile:TypedImplFile option + + latestCcuSigForFile: ModuleOrNamespaceType option tcDependencyFiles: string list @@ -1126,7 +1128,8 @@ type PartialCheckResults = TcDependencyFiles: string list TopAttribs: TopAttribs option TimeStamp: DateTime - LatestImplementationFile: TypedImplFile option } + LatestImplementationFile: TypedImplFile option + LastestCcuSigForFile: ModuleOrNamespaceType option } member x.TcErrors = Array.concat (List.rev x.TcErrorsRev) member x.TcSymbolUses = List.rev x.TcSymbolUsesRev @@ -1144,7 +1147,8 @@ type PartialCheckResults = TcDependencyFiles = tcAcc.tcDependencyFiles TopAttribs = tcAcc.topAttribs TimeStamp = timestamp - LatestImplementationFile = tcAcc.lastestTypedImplFile } + LatestImplementationFile = tcAcc.latestImplFile + LastestCcuSigForFile = tcAcc.latestCcuSigForFile } [] @@ -1350,7 +1354,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcSymbolUsesRev=[] tcOpenDeclarationsRev=[] topAttribs=None - lastestTypedImplFile=None + latestImplFile=None + latestCcuSigForFile=None tcDependencyFiles=basicDependencies tcErrorsRev = [ initialErrors ] } return tcAcc } @@ -1373,7 +1378,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let sink = TcResultsSinkImpl(tcAcc.tcGlobals) let hadParseErrors = not (Array.isEmpty parseErrors) - let! (tcEnvAtEndOfFile, topAttribs, lastestTypedImplFile), tcState = + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = TypeCheckOneInputEventually ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), tcConfig, tcAcc.tcImports, @@ -1383,7 +1388,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcAcc.tcState, input) /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - let lastestTypedImplFile = if keepAssemblyContents then lastestTypedImplFile else None + let implFile = if keepAssemblyContents then implFile else None let tcResolutions = if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty let tcEnvAtEndOfFile = (if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls) let tcSymbolUses = sink.GetSymbolUses() @@ -1395,7 +1400,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput return {tcAcc with tcState=tcState tcEnvAtEndOfFile=tcEnvAtEndOfFile topAttribs=Some topAttribs - lastestTypedImplFile=lastestTypedImplFile + latestImplFile=implFile + latestCcuSigForFile=Some ccuSigForFile tcResolutionsRev=tcResolutions :: tcAcc.tcResolutionsRev tcSymbolUsesRev=tcSymbolUses :: tcAcc.tcSymbolUsesRev tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: tcAcc.tcOpenDeclarationsRev @@ -1437,16 +1443,16 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let finalAcc = tcStates.[tcStates.Length-1] // Finish the checking - let (_tcEnvAtEndOfLastFile, topAttrs, mimpls), tcState = - let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnvAtEndOfFile, defaultArg acc.topAttribs EmptyTopAttrs, acc.lastestTypedImplFile) + let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = + let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnvAtEndOfFile, defaultArg acc.topAttribs EmptyTopAttrs, acc.latestImplFile, acc.latestCcuSigForFile) TypeCheckMultipleInputsFinish (results, finalAcc.tcState) let ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = try - // TypeCheckClosedInputSetFinish fills in tcState.Ccu but in incremental scenarios we don't want this, - // so we make this temporary here - let oldContents = tcState.Ccu.Deref.Contents - try + // TypeCheckClosedInputSetFinish fills in tcState.Ccu but in incremental scenarios we don't want this, + // so we make this temporary here + let oldContents = tcState.Ccu.Deref.Contents + try let tcState, tcAssemblyExpr = TypeCheckClosedInputSetFinish (mimpls, tcState) // Compute the identity of the generated assembly based on attributes, options etc. diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 0f41ce105442..b6b64a7ffd01 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -64,7 +64,10 @@ type internal PartialCheckResults = /// Represents latest complete typechecked implementation file, including its typechecked signature if any. /// Empty for a signature file. - LatestImplementationFile: TypedImplFile option } + LatestImplementationFile: TypedImplFile option + + /// Represents latest inferred signature contents. + LastestCcuSigForFile: ModuleOrNamespaceType option} member TcErrors: (PhasedDiagnostic * FSharpErrorSeverity)[] diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index f5f4a64025fd..44a1d6b6a991 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -152,7 +152,7 @@ type TypeCheckInfo _sTcConfig: TcConfig, g: TcGlobals, // The signature of the assembly being checked, up to and including the current file - ccuSig: ModuleOrNamespaceType, + ccuSigForFile: ModuleOrNamespaceType, thisCcu: CcuThunk, tcImports: TcImports, tcAccessRights: AccessorDomain, @@ -939,7 +939,7 @@ type TypeCheckInfo | None -> FSharpDeclarationListInfo.Empty | Some (items, denv, ctx, m) -> let items = if isInterfaceFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items - let getAccessibility item = FSharpSymbol.GetAccessibility (FSharpSymbol.Create(g, thisCcu, tcImports, item)) + let getAccessibility item = FSharpSymbol.GetAccessibility (FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item)) let currentNamespaceOrModule = parseResultsOpt |> Option.bind (fun x -> x.ParseTree) @@ -1018,7 +1018,7 @@ type TypeCheckInfo | [] -> failwith "Unexpected empty bag" | items -> items - |> List.map (fun item -> let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item.Item) + |> List.map (fun item -> let symbol = FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item.Item) FSharpSymbolUse(g, denv, symbol, ItemOccurence.Use, m))) //end filtering @@ -1134,14 +1134,14 @@ type TypeCheckInfo | None | Some ([],_,_,_) -> None | Some (items, denv, _, m) -> let allItems = items |> List.collect (fun item -> SymbolHelpers.FlattenItems g m item.Item) - let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(g, thisCcu, tcImports, item)) + let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item)) Some (symbols, denv, m) ) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetMethodsAsSymbols: '%s'" msg) None) - member scope.GetDeclarationLocation (ctok, line, lineStr, colAtEndOfNames, names, preferFlag) = + member __.GetDeclarationLocation (ctok, line, lineStr, colAtEndOfNames, names, preferFlag) = ErrorScope.Protect Range.range0 (fun () -> match GetDeclItemsForNamesAtPosition (ctok, None,Some(names), None, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors,ResolveOverloads.Yes,(fun() -> []), fun _ -> false) with @@ -1242,20 +1242,21 @@ type TypeCheckInfo Trace.TraceInformation(sprintf "FCS: recovering from error in GetDeclarationLocation: '%s'" msg) FSharpFindDeclResult.DeclNotFound (FSharpFindDeclFailureReason.Unknown msg)) - member scope.GetSymbolUseAtLocation (ctok, line, lineStr, colAtEndOfNames, names) = + member __.GetSymbolUseAtLocation (ctok, line, lineStr, colAtEndOfNames, names) = ErrorScope.Protect Range.range0 (fun () -> match GetDeclItemsForNamesAtPosition (ctok, None,Some(names), None, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.Yes,(fun() -> []), fun _ -> false) with | None | Some ([], _, _, _) -> None | Some (item :: _, denv, _, m) -> - let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item.Item) + let symbol = FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item.Item) Some (symbol, denv, m) ) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetSymbolUseAtLocation: '%s'" msg) None) - member scope.PartialAssemblySignature() = FSharpAssemblySignature(g, thisCcu, tcImports, None, ccuSig) + member __.PartialAssemblySignatureForFile = + FSharpAssemblySignature(g, thisCcu, ccuSigForFile, tcImports, None, ccuSigForFile) member __.AccessRights = tcAccessRights @@ -1389,7 +1390,7 @@ type TypeCheckInfo member __.TcImports = tcImports /// The inferred signature of the file - member __.CcuSig = ccuSig + member __.CcuSigForFile = ccuSigForFile /// The assembly being analyzed member __.ThisCcu = thisCcu @@ -1697,7 +1698,7 @@ module internal Parser = let sink = TcResultsSinkImpl(tcGlobals, source = source) let! ct = Async.CancellationToken - let! tcEnvAtEndOpt = + let! resOpt = async { try let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -1719,24 +1720,22 @@ module internal Parser = cancellable.Return(res) )) - return result |> Option.map (fun ((tcEnvAtEnd, _, typedImplFiles), tcState) -> tcEnvAtEnd, typedImplFiles, tcState) - with - | e -> + return result |> Option.map (fun ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> tcEnvAtEnd, implFiles, ccuSigsForFiles, tcState) + with e -> errorR e - return Some(tcState.TcEnvFromSignatures, [], tcState) + return Some(tcState.TcEnvFromSignatures, [], [NewEmptyModuleOrNamespaceType Namespace], tcState) } let errors = errHandler.CollectedDiagnostics - match tcEnvAtEndOpt with - | Some (tcEnvAtEnd, implFiles, tcState) -> + match resOpt with + | Some (tcEnvAtEnd, implFiles, ccuSigsForFiles, tcState) -> let scope = TypeCheckInfo(tcConfig, tcGlobals, - tcState.PartialAssemblySignature, + List.head ccuSigsForFiles, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights, - //typedImplFiles, projectFileName, mainInputFileName, sink.GetResolutions(), @@ -1807,7 +1806,8 @@ type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. -type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssemblyContents, errors: FSharpErrorInfo[], details:(TcGlobals*TcImports*CcuThunk*ModuleOrNamespaceType*TcSymbolUses list*TopAttribs option*CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option, _reactorOps: IReactorOperations) = +type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssemblyContents, errors: FSharpErrorInfo[], + details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * TcSymbolUses list * TopAttribs option * CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option) = let getDetails() = match details with @@ -1825,7 +1825,7 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem member info.AssemblySignature = let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() - FSharpAssemblySignature(tcGlobals, thisCcu, tcImports, topAttribs, ccuSig) + FSharpAssemblySignature(tcGlobals, thisCcu, ccuSig, tcImports, topAttribs, ccuSig) member info.TypedImplementionFiles = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" @@ -1836,10 +1836,22 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem | Some mimpls -> mimpls tcGlobals, thisCcu, tcImports, mimpls - member info.AssemblyContents = FSharpAssemblyContents(info.TypedImplementionFiles) + member info.AssemblyContents = + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let mimpls = + match tcAssemblyExpr with + | None -> [] + | Some mimpls -> mimpls + FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) member info.GetOptimizedAssemblyContents() = - let tcGlobals, thisCcu, tcImports, mimpls = info.TypedImplementionFiles + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let mimpls = + match tcAssemblyExpr with + | None -> [] + | Some mimpls -> mimpls let outfile = "" // only used if tcConfig.writeTermsToFiles is true let importMap = tcImports.GetImportMap() let optEnv0 = GetInitialOptimizationEnv (tcImports, tcGlobals) @@ -1850,7 +1862,7 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem | TypedAssemblyAfterOptimization files -> files |> List.map fst - FSharpAssemblyContents(tcGlobals, thisCcu, tcImports, mimpls) + FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) // Not, this does not have to be a SyncOp, it can be called from any thread member info.GetUsesOfSymbol(symbol:FSharpSymbol) = @@ -1865,32 +1877,32 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem |> async.Return // Not, this does not have to be a SyncOp, it can be called from any thread - member info.GetAllUsesOfAllSymbols() = - let (tcGlobals, tcImports, thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + member __.GetAllUsesOfAllSymbols() = + let (tcGlobals, tcImports, thisCcu, ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() [| for r in tcSymbolUses do for symbolUse in r.AllUsesOfSymbols do if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(tcGlobals, thisCcu, tcImports, symbolUse.Item) + let symbol = FSharpSymbol.Create(tcGlobals, thisCcu, ccuSig, tcImports, symbolUse.Item) yield FSharpSymbolUse(tcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |] |> async.Return - member info.ProjectContext = + member __.ProjectContext = let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() let assemblies = [ for x in tcImports.GetImportedAssemblies() do yield FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata) ] FSharpProjectContext(thisCcu, assemblies, ad) - member info.RawFSharpAssemblyData = + member __.RawFSharpAssemblyData = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() tcAssemblyData - member info.DependencyFiles = + member __.DependencyFiles = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles) = getDetails() dependencyFiles - member info.AssemblyFullName = + member __.AssemblyFullName = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() ilAssemRef.QualifiedName @@ -2029,33 +2041,33 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp member info.GetFormatSpecifierLocationsAndArity() = threadSafeOp - (fun () -> [| |]) - (fun scope -> - // This operation is not asynchronous - GetFormatSpecifierLocationsAndArity can be run on the calling thread - scope.GetFormatSpecifierLocationsAndArity()) + (fun () -> [| |]) + (fun scope -> + // This operation is not asynchronous - GetFormatSpecifierLocationsAndArity can be run on the calling thread + scope.GetFormatSpecifierLocationsAndArity()) - member info.GetSemanticClassification(range: range option) = + member __.GetSemanticClassification(range: range option) = threadSafeOp - (fun () -> [| |]) - (fun scope -> - // This operation is not asynchronous - GetSemanticClassification can be run on the calling thread - scope.GetSemanticClassification(range)) + (fun () -> [| |]) + (fun scope -> + // This operation is not asynchronous - GetSemanticClassification can be run on the calling thread + scope.GetSemanticClassification(range)) - member info.PartialAssemblySignature = + member __.PartialAssemblySignature = threadSafeOp (fun () -> failwith "not available") (fun scope -> - // This operation is not asynchronous - PartialAssemblySignature can be run on the calling thread - scope.PartialAssemblySignature()) + // This operation is not asynchronous - PartialAssemblySignature can be run on the calling thread + scope.PartialAssemblySignatureForFile) - member info.ProjectContext = + member __.ProjectContext = threadSafeOp (fun () -> failwith "not available") (fun scope -> // This operation is not asynchronous - GetReferencedAssemblies can be run on the calling thread FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights)) - member info.DependencyFiles = dependencyFiles + member __.DependencyFiles = dependencyFiles member info.GetAllUsesOfAllSymbolsInFile() = threadSafeOp @@ -2063,7 +2075,7 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp (fun scope -> [| for symbolUse in scope.ScopeSymbolUses.AllUsesOfSymbols do if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(scope.TcGlobals, scope.ThisCcu, scope.TcImports, symbolUse.Item) + let symbol = FSharpSymbol.Create(scope.TcGlobals, scope.ThisCcu, scope.CcuSigForFile, scope.TcImports, symbolUse.Item) yield FSharpSymbolUse(scope.TcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |]) |> async.Return @@ -2098,21 +2110,15 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX |> Option.map (fun scope -> - let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) + let cenv = SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) scope.ImplementationFile |> Option.map (fun implFile -> FSharpImplementationFileContents(cenv, implFile))) |> Option.defaultValue None member info.OpenDeclarations = scopeOptX |> Option.map (fun scope -> - let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) - scope.OpenDeclarations |> Array.map (fun x -> - { LongId = x.LongId - Range = x.Range - Modules = x.Modules |> List.map (fun x -> FSharpEntity(cenv, x)) - AppliedScope = x.AppliedScope - IsOwnNamespace = x.IsOwnNamespace } - : FSharpOpenDeclaration )) + let cenv = SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) + scope.OpenDeclarations |> Array.map (fun x -> FSharpOpenDeclaration(x.LongId, x.Range, (x.Modules |> List.map (fun x -> FSharpEntity(cenv, x))), x.AppliedScope, x.IsOwnNamespace))) |> Option.defaultValue [| |] override info.ToString() = "FSharpCheckFileResults(" + filename + ")" @@ -2701,7 +2707,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let parseResults = FSharpParseFileResults(errors = untypedErrors, input = parseTreeOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.TryGet (ltok, options) ) let scope = - TypeCheckInfo(tcProj.TcConfig, tcProj.TcGlobals, tcProj.TcState.PartialAssemblySignature, tcProj.TcState.Ccu, tcProj.TcImports, tcProj.TcEnvAtEnd.AccessRights, + TypeCheckInfo(tcProj.TcConfig, tcProj.TcGlobals, + Option.get tcProj.LastestCcuSigForFile, + tcProj.TcState.Ccu, tcProj.TcImports, tcProj.TcEnvAtEnd.AccessRights, options.ProjectFileName, filename, List.head tcProj.TcResolutionsRev, List.head tcProj.TcSymbolUsesRev, @@ -2731,13 +2739,16 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC use _unwind = decrement match builderOpt with | None -> - return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationErrors, None, reactorOps) + return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationErrors, None) | Some builder -> let! (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject(ctok) let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (errorOptions, true, fileName, tcProj.TcErrors) |] - return FSharpCheckProjectResults (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, errors, Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.PartialAssemblySignature, tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcProj.TcDependencyFiles), reactorOps) + return FSharpCheckProjectResults (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, errors, + Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.CcuSig, + tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, + tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcProj.TcDependencyFiles)) } /// Get the timestamp that would be on the output if fully built immediately @@ -3267,10 +3278,14 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio return match tcFileResult with - | Parser.TypeCheckAborted.No scope -> + | Parser.TypeCheckAborted.No tcFileInfo -> let errors = [| yield! parseErrors; yield! tcErrors |] - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps, false) - let projectResults = FSharpCheckProjectResults (filename, Some tcConfig, keepAssemblyContents, errors, Some(tcGlobals, tcImports, scope.ThisCcu, scope.CcuSig, [scope.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles), reactorOps) + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, reactorOps, false) + let projectResults = + FSharpCheckProjectResults (filename, Some tcConfig, keepAssemblyContents, errors, + Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, + [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", + tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles)) parseResults, typeCheckResults, projectResults | _ -> failwith "unexpected aborted" diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index d818cf956a1a..ecbcea10199d 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -268,7 +268,7 @@ module FSharpExprConvert = | DT_REF -> None | _ -> None - let (|TTypeConvOp|_|) (cenv:Impl.cenv) ty = + let (|TTypeConvOp|_|) (cenv:SymbolEnv) ty = let g = cenv.g match ty with | TType_app (tcref,_) -> @@ -291,14 +291,14 @@ module FSharpExprConvert = let ConvType cenv typ = FSharpType(cenv, typ) let ConvTypes cenv typs = List.map (ConvType cenv) typs - let ConvILTypeRefApp (cenv:Impl.cenv) m tref tyargs = + let ConvILTypeRefApp (cenv:SymbolEnv) m tref tyargs = let tcref = Import.ImportILTypeRef cenv.amap m tref ConvType cenv (mkAppTy tcref tyargs) let ConvUnionCaseRef cenv (ucref:UnionCaseRef) = FSharpUnionCase(cenv, ucref) let ConvRecdFieldRef cenv (rfref:RecdFieldRef) = FSharpField(cenv, rfref ) - let rec exprOfExprAddr (cenv:Impl.cenv) expr = + let rec exprOfExprAddr (cenv:SymbolEnv) expr = match expr with | Expr.Op(op, tyargs, args, m) -> match op, args, tyargs with @@ -323,7 +323,7 @@ module FSharpExprConvert = let Mk2 cenv (orig:Expr) e = FSharpExpr(cenv, None, e, orig.Range, tyOfExpr cenv.g orig) - let rec ConvLValueExpr (cenv:Impl.cenv) env expr = ConvExpr cenv env (exprOfExprAddr cenv expr) + let rec ConvLValueExpr (cenv:SymbolEnv) env expr = ConvExpr cenv env (exprOfExprAddr cenv expr) and ConvExpr cenv env expr = Mk2 cenv expr (ConvExprPrim cenv env expr) @@ -391,7 +391,7 @@ module FSharpExprConvert = /// A nasty function copied from creflect.fs. Made nastier by taking a continuation to process the /// arguments to the call in a tail-recursive fashion. - and ConvModuleValueOrMemberUseLinear (cenv:Impl.cenv) env (expr:Expr, vref, vFlags, tyargs, curriedArgs) contf = + and ConvModuleValueOrMemberUseLinear (cenv:SymbolEnv) env (expr:Expr, vref, vFlags, tyargs, curriedArgs) contf = let m = expr.Range let (numEnclTypeArgs, _, isNewObj, _valUseFlags, _isSelfInit, takesInstanceArg, _isPropGet, _isPropSet) = @@ -462,7 +462,7 @@ module FSharpExprConvert = // tailcall ConvObjectModelCallLinear cenv env (false, v, [], tyargs, List.concat untupledCurriedArgs) contf2 - and ConvExprPrim (cenv:Impl.cenv) (env:ExprTranslationEnv) expr = + and ConvExprPrim (cenv:SymbolEnv) (env:ExprTranslationEnv) expr = // Eliminate integer 'for' loops let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr @@ -854,7 +854,7 @@ module FSharpExprConvert = let envinner = env.BindVal v Some(vR, rhsR), envinner - and ConvILCall (cenv:Impl.cenv) env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = + and ConvILCall (cenv:SymbolEnv) env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = let isNewObj = (isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false)) let methName = ilMethRef.Name let isPropGet = methName.StartsWith("get_", System.StringComparison.Ordinal) @@ -1210,9 +1210,9 @@ module FSharpExprConvert = /// The contents of the F# assembly as provided through the compiler API -type FSharpAssemblyContents(cenv: Impl.cenv, mimpls: TypedImplFile list) = +type FSharpAssemblyContents(cenv: SymbolEnv, mimpls: TypedImplFile list) = - new (g, thisCcu, tcImports, mimpls) = FSharpAssemblyContents(Impl.cenv(g, thisCcu, tcImports), mimpls) + new (g, thisCcu, thisCcuType, tcImports, mimpls) = FSharpAssemblyContents(SymbolEnv(g, thisCcu, thisCcuType, tcImports), mimpls) member __.ImplementationFiles = [ for mimpl in mimpls -> FSharpImplementationFileContents(cenv, mimpl)] @@ -1223,7 +1223,7 @@ and FSharpImplementationFileDeclaration = | InitAction of FSharpExpr and FSharpImplementationFileContents(cenv, mimpl) = - let (TImplFile(qname, _pragmas, ModuleOrNamespaceExprWithSig(_mty, mdef, _), hasExplicitEntryPoint, isScript)) = mimpl + let (TImplFile(qname, _pragmas, ModuleOrNamespaceExprWithSig(_, mdef, _), hasExplicitEntryPoint, isScript)) = mimpl let rec getDecls2 (ModuleOrNamespaceExprWithSig(_mty, def, _m)) = getDecls def and getBind (bind: Binding) = let v = bind.Var diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 7e0e17ac8dd4..c9049b33c1ac 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -12,14 +12,14 @@ open Microsoft.FSharp.Compiler.CompileOps /// Represents the definitional contents of an assembly, as seen by the F# language type public FSharpAssemblyContents = - internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents + internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuType: ModuleOrNamespaceType option * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents /// The contents of the implementation files in the assembly member ImplementationFiles: FSharpImplementationFileContents list /// Represents the definitional contents of a single file or fragment in an assembly, as seen by the F# language and [] public FSharpImplementationFileContents = - internal new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents + internal new : cenv: SymbolEnv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations member QualifiedName: string diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index a21b26650b35..f24fed090af5 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -49,6 +49,16 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = let mangledTextOfCompPath (CompPath(scoref, path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path) String.concat ";" (List.map mangledTextOfCompPath paths) +type SymbolEnv(g:TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports) = + let amapV = tcImports.GetImportMap() + let infoReaderV = InfoReader(g, amapV) + member __.g = g + member __.amap = amapV + member __.thisCcu = thisCcu + member __.thisCcuTyp = thisCcuTyp + member __.infoReader = infoReaderV + member __.tcImports = tcImports + [] module Impl = let protect f = @@ -58,7 +68,7 @@ module Impl = let makeReadOnlyCollection (arr: seq<'T>) = System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> - + let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection (x) let rescopeEntity optViewedCcu (entity: Entity) = @@ -166,16 +176,7 @@ module Impl = | None -> None - type cenv(g:TcGlobals, thisCcu: CcuThunk , tcImports: TcImports) = - let amapV = tcImports.GetImportMap() - let infoReaderV = InfoReader(g, amapV) - member __.g = g - member __.amap = amapV - member __.thisCcu = thisCcu - member __.infoReader = infoReaderV - member __.tcImports = tcImports - - let getXmlDocSigForEntity (cenv: cenv) (ent:EntityRef)= + let getXmlDocSigForEntity (cenv: SymbolEnv) (ent:EntityRef)= match SymbolHelpers.GetXmlDocSigOfEntityRef cenv.infoReader ent.Range ent with | Some (_, docsig) -> docsig | _ -> "" @@ -186,7 +187,7 @@ type FSharpDisplayContext(denv: TcGlobals -> DisplayEnv) = // delay the realization of 'item' in case it is unresolved -type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuThunk -> AccessorDomain -> bool)) = +type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol -> CcuThunk -> AccessorDomain -> bool)) = member x.Assembly = let ccu = defaultArg (SymbolHelpers.ccuOfItem cenv.g x.Item) cenv.thisCcu @@ -207,6 +208,8 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT member x.IsEffectivelySameAs(y:FSharpSymbol) = x.Equals(y) || ItemsAreEffectivelyEqual cenv.g x.Item y.Item + member x.GetEffectivelySameAsHash() = ItemsAreEffectivelyEqualHash cenv.g x.Item + member internal x.Item = item() member x.DisplayName = item().DisplayName @@ -221,12 +224,90 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT override x.GetHashCode() = hash x.ImplementationLocation - member x.GetEffectivelySameAsHash() = ItemsAreEffectivelyEqualHash cenv.g x.Item - override x.ToString() = "symbol " + (try item().DisplayName with _ -> "?") + // TODO: there are several cases where we may need to report more interesting + // symbol information below. By default we return a vanilla symbol. + static member Create(g, thisCcu, thisCcuType, tcImports, item): FSharpSymbol = + FSharpSymbol.Create (SymbolEnv(g, thisCcu, Some thisCcuType, tcImports), item) + + static member Create(cenv, item): FSharpSymbol = + let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) + match item with + | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ + | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ + | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ + | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ + + | Item.ILField finfo -> FSharpField(cenv, ILField finfo) :> _ + + | Item.Event einfo -> + FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ + + | Item.Property(_, pinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ + + | Item.MethodGroup(_, minfo :: _, _) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + + | Item.CtorGroup(_, cinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ + + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> + FSharpEntity(cenv, tcref) :>_ + + | Item.UnqualifiedType(tcref :: _) + | Item.Types(_, AbbrevOrAppTy tcref :: _) -> + FSharpEntity(cenv, tcref) :>_ + + | Item.ModuleOrNamespaces(modref :: _) -> + FSharpEntity(cenv, modref) :> _ + + | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) + + | Item.CustomOperation (_customOpName, _, Some minfo) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + + | Item.CustomBuilder (_, vref) -> + FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ + + | Item.TypeVar (_, tp) -> + FSharpGenericParameter(cenv, tp) :> _ + + | Item.ActivePatternCase apref -> + FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ + + | Item.ActivePatternResult (apinfo, typ, n, _) -> + FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ + + | Item.ArgName(id, ty, _) -> + FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ -and FSharpEntity(cenv:cenv, entity:EntityRef) = + // TODO: the following don't currently return any interesting subtype + | Item.ImplicitOp _ + | Item.ILField _ + | Item.FakeInterfaceCtor _ + | Item.NewDef _ -> dflt() + // These cases cover unreachable cases + | Item.CustomOperation (_, _, None) + | Item.UnqualifiedType [] + | Item.ModuleOrNamespaces [] + | Item.Property (_, []) + | Item.MethodGroup (_, [], _) + | Item.CtorGroup (_, []) + // These cases cover misc. corned cases (non-symbol types) + | Item.Types _ + | Item.DelegateCtor _ -> dflt() + + static member GetAccessibility (symbol: FSharpSymbol) = + match symbol with + | :? FSharpEntity as x -> Some x.Accessibility + | :? FSharpField as x -> Some x.Accessibility + | :? FSharpUnionCase as x -> Some x.Accessibility + | :? FSharpMemberFunctionOrValue as x -> Some x.Accessibility + | _ -> None + +and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = inherit FSharpSymbol(cenv, (fun () -> checkEntityIsResolved(entity); @@ -276,6 +357,21 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = | Some (CompPath(_, [])) -> "global" | Some cp -> buildAccessPath (Some cp) + member x.DeclaringEntity = + match entity.CompilationPathOpt with + | None -> None + | Some (CompPath(_, [])) -> None + | Some cp -> + match x.Assembly.Contents.FindEntityByPath cp.MangledPath with + | Some res -> Some res + | None -> + // The declaring entity may be in this assembly, including a type possibly hidden by a signature. + match cenv.thisCcuTyp with + | Some t -> + let s = FSharpAssemblySignature(cenv, None, None, t) + s.FindEntityByPath cp.MangledPath + | None -> None + member __.Namespace = checkIsResolved() match entity.CompilationPathOpt with @@ -730,7 +826,7 @@ and FSharpFieldData = | Union (v, _) -> v.TyconRef | ILField f -> f.DeclaringTyconRef -and FSharpField(cenv: cenv, d: FSharpFieldData) = +and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = inherit FSharpSymbol (cenv, (fun () -> match d with @@ -769,6 +865,7 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = | ILField _ -> () new (cenv, ucref, n) = FSharpField(cenv, FSharpFieldData.Union(ucref, n)) + new (cenv, rfref) = FSharpField(cenv, FSharpFieldData.RecdOrClass(rfref)) member __.DeclaringEntity = @@ -891,6 +988,7 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = FSharpAccessibility(access) member private x.V = d + override x.Equals(other: obj) = box x === other || match other with @@ -902,14 +1000,15 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = | _ -> false override x.GetHashCode() = hash x.Name + override x.ToString() = "field " + x.Name and [] FSharpRecordField = FSharpField and [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = member internal __.ThisCcu = thisCcu - member internal __.Contents = ad + member internal __.Contents = ad and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, typ, n, valOpt: ValRef option, item) = @@ -960,13 +1059,19 @@ and FSharpGenericParameter(cenv, v:Typar) = inherit FSharpSymbol (cenv, (fun () -> Item.TypeVar(v.Name, v)), (fun _ _ _ad -> true)) + member __.Name = v.DisplayName + member __.DeclarationLocation = v.Range + member __.IsCompilerGenerated = v.IsCompilerGenerated member __.IsMeasure = (v.Kind = TyparKind.Measure) + member __.XmlDoc = v.typar_xmldoc |> makeXmlDoc + member __.IsSolveAtCompileTime = (v.StaticReq = TyparStaticReq.HeadTypeStaticReq) + member __.Attributes = // INCOMPLETENESS: If the type parameter comes from .NET then the .NET metadata for the type parameter // has been lost (it is not accessible via Typar). So we can't easily report the attributes in this @@ -1509,9 +1614,9 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m | C m -> m.IsInstance | V v -> v.IsInstanceMember - member v.IsInstanceMemberInCompiledCode = + member x.IsInstanceMemberInCompiledCode = if isUnresolved() then false else - v.IsInstanceMember && + x.IsInstanceMember && match d with | E e -> match e.ArbitraryValRef with Some vref -> ValRefIsCompiledAsInstanceMember cenv.g vref | None -> true | P p -> match p.ArbitraryValRef with Some vref -> ValRefIsCompiledAsInstanceMember cenv.g vref | None -> true @@ -1527,7 +1632,8 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | V v -> v.IsExtensionMember | C _ -> false - member this.IsOverrideOrExplicitMember = this.IsOverrideOrExplicitInterfaceImplementation + member x.IsOverrideOrExplicitMember = x.IsOverrideOrExplicitInterfaceImplementation + member __.IsOverrideOrExplicitInterfaceImplementation = if isUnresolved() then false else match d with @@ -1863,7 +1969,7 @@ and FSharpType(cenv, typ:TType) = let isResolved() = not (isUnresolved()) - new (g, thisCcu, tcImports, typ) = FSharpType(cenv(g, thisCcu, tcImports), typ) + new (g, thisCcu, thisCcuTyp, tcImports, typ) = FSharpType(SymbolEnv(g, thisCcu, Some thisCcuTyp, tcImports), typ) member __.IsUnresolved = isUnresolved() @@ -2045,7 +2151,7 @@ and FSharpType(cenv, typ:TType) = let ps = (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection ps, returnParameter.AdjustType(prettyRetTy) -and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = +and FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = let rec resolveArgObj (arg: obj) = match arg with @@ -2128,16 +2234,26 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA let attribs = topArgInfo.Attribs let idOpt = topArgInfo.Name let m = match mOpt with Some m -> m | None -> range0 + member __.Name = match idOpt with None -> None | Some v -> Some v.idText - member __.cenv: cenv = cenv + + member __.cenv: SymbolEnv = cenv + member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg) + member __.Type: FSharpType = FSharpType(cenv, typ) + member __.V = typ + member __.DeclarationLocation = match idOpt with None -> m | Some v -> v.idRange + member __.Attributes = attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + member __.IsParamArrayArg = isParamArrayArg + member __.IsOutArg = isOutArg + member __.IsOptionalArg = isOptionalArg member private x.ValReprInfo = topArgInfo @@ -2149,16 +2265,20 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA | _ -> false override x.GetHashCode() = hash (box topArgInfo) + override x.ToString() = "parameter " + (match x.Name with None -> " s) -and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = +and FSharpAssemblySignature (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = // Assembly signature for a referenced/linked assembly - new (cenv, ccu: CcuThunk) = FSharpAssemblySignature((if ccu.IsUnresolvedReference then cenv else (new cenv(cenv.g, ccu, cenv.tcImports))), None, Some ccu, ccu.Contents.ModuleOrNamespaceType) + new (cenv: SymbolEnv, ccu: CcuThunk) = + let cenv = if ccu.IsUnresolvedReference then cenv else SymbolEnv(cenv.g, ccu, None, cenv.tcImports) + FSharpAssemblySignature(cenv, None, Some ccu, ccu.Contents.ModuleOrNamespaceType) // Assembly signature for an assembly produced via type-checking. - new (g, thisCcu, tcImports, topAttribs, mtyp) = FSharpAssemblySignature(cenv(g, thisCcu, tcImports), topAttribs, None, mtyp) + new (g, thisCcu, thisCcuTyp, tcImports, topAttribs, mtyp) = + FSharpAssemblySignature(SymbolEnv(g, thisCcu, Some thisCcuTyp, tcImports), topAttribs, None, mtyp) member __.Entities = @@ -2194,14 +2314,15 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op |> makeReadOnlyCollection member __.FindEntityByPath path = - let inline findNested name = function - | Some (e: Entity) when e.IsModuleOrNamespace -> - e.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind name + let findNested name entity = + match entity with + | Some (e: Entity) ->e.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind name | _ -> None match path with | hd :: tl -> - List.fold (fun a x -> findNested x a) (mtyp.AllEntitiesByCompiledAndLogicalMangledNames.TryFind hd) tl + (mtyp.AllEntitiesByCompiledAndLogicalMangledNames.TryFind hd, tl) + ||> List.fold (fun a x -> findNested x a) |> Option.map (fun e -> FSharpEntity(cenv, rescopeEntity optViewedCcu e)) | _ -> None @@ -2209,120 +2330,60 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op and FSharpAssembly internal (cenv, ccu: CcuThunk) = - new (g, tcImports, ccu) = FSharpAssembly(cenv(g, ccu, tcImports), ccu) + new (g, tcImports, ccu: CcuThunk) = + FSharpAssembly(SymbolEnv(g, ccu, None, tcImports), ccu) member __.RawCcuThunk = ccu - member __.QualifiedName = match ccu.QualifiedName with None -> "" | Some s -> s - member __.CodeLocation = ccu.SourceCodeDirectory - member __.FileName = ccu.FileName - member __.SimpleName = ccu.AssemblyName - #if !NO_EXTENSIONTYPING - member __.IsProviderGenerated = ccu.IsProviderGenerated - #endif - member __.Contents = FSharpAssemblySignature(cenv, ccu) - - override x.ToString() = x.QualifiedName -type FSharpSymbol with - // TODO: there are several cases where we may need to report more interesting - // symbol information below. By default we return a vanilla symbol. - static member Create(g, thisCcu, tcImports, item): FSharpSymbol = - FSharpSymbol.Create (cenv(g, thisCcu, tcImports), item) - - static member Create(cenv, item): FSharpSymbol = - let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) - match item with - | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ - | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ - | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ - | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ - - | Item.ILField finfo -> FSharpField(cenv, ILField finfo) :> _ - - | Item.Event einfo -> - FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ - - | Item.Property(_, pinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ - - | Item.MethodGroup(_, minfo :: _, _) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ - - | Item.CtorGroup(_, cinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ - - | Item.DelegateCtor (AbbrevOrAppTy tcref) -> - FSharpEntity(cenv, tcref) :>_ - - | Item.UnqualifiedType(tcref :: _) - | Item.Types(_, AbbrevOrAppTy tcref :: _) -> - FSharpEntity(cenv, tcref) :>_ + member __.QualifiedName = match ccu.QualifiedName with None -> "" | Some s -> s - | Item.ModuleOrNamespaces(modref :: _) -> - FSharpEntity(cenv, modref) :> _ + member __.CodeLocation = ccu.SourceCodeDirectory - | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) + member __.FileName = ccu.FileName - | Item.CustomOperation (_customOpName, _, Some minfo) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + member __.SimpleName = ccu.AssemblyName - | Item.CustomBuilder (_, vref) -> - FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ +#if !NO_EXTENSIONTYPING + member __.IsProviderGenerated = ccu.IsProviderGenerated +#endif - | Item.TypeVar (_, tp) -> - FSharpGenericParameter(cenv, tp) :> _ + member __.Contents : FSharpAssemblySignature = FSharpAssemblySignature(cenv, ccu) + + override x.ToString() = ccu.ILScopeRef.QualifiedName - | Item.ActivePatternCase apref -> - FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ +/// Represents open declaration in F# code. +[] +type FSharpOpenDeclaration(longId: Ident list, range: range option, modules: FSharpEntity list, appliedScope: range, isOwnNamespace: bool) = - | Item.ActivePatternResult (apinfo, typ, n, _) -> - FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ + member __.LongId = longId - | Item.ArgName(id, ty, _) -> - FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ + member __.Range = range - // TODO: the following don't currently return any interesting subtype - | Item.ImplicitOp _ - | Item.ILField _ - | Item.FakeInterfaceCtor _ - | Item.NewDef _ -> dflt() - // These cases cover unreachable cases - | Item.CustomOperation (_, _, None) - | Item.UnqualifiedType [] - | Item.ModuleOrNamespaces [] - | Item.Property (_, []) - | Item.MethodGroup (_, [], _) - | Item.CtorGroup (_, []) - // These cases cover misc. corned cases (non-symbol types) - | Item.Types _ - | Item.DelegateCtor _ -> dflt() + member __.Modules = modules - static member GetAccessibility (symbol: FSharpSymbol) = - match symbol with - | :? FSharpEntity as x -> Some x.Accessibility - | :? FSharpField as x -> Some x.Accessibility - | :? FSharpUnionCase as x -> Some x.Accessibility - | :? FSharpMemberFunctionOrValue as x -> Some x.Accessibility - | _ -> None + member __.AppliedScope = appliedScope -/// Represents open declaration in F# code. -type FSharpOpenDeclaration = - { LongId: Ident list - Range: range option - Modules: FSharpEntity list - AppliedScope: range - IsOwnNamespace: bool } + member __.IsOwnNamespace = isOwnNamespace [] type FSharpSymbolUse(g:TcGlobals, denv: DisplayEnv, symbol:FSharpSymbol, itemOcc, range: range) = + member __.Symbol = symbol + member __.DisplayContext = FSharpDisplayContext(fun _ -> denv) + member x.IsDefinition = x.IsFromDefinition + member __.IsFromDefinition = itemOcc = ItemOccurence.Binding + member __.IsFromPattern = itemOcc = ItemOccurence.Pattern + member __.IsFromType = itemOcc = ItemOccurence.UseInType + member __.IsFromAttribute = itemOcc = ItemOccurence.UseInAttribute + member __.IsFromDispatchSlotImplementation = itemOcc = ItemOccurence.Implemented + member __.IsFromComputationExpression = match symbol.Item, itemOcc with // 'seq' in 'seq { ... }' gets colored as keywords @@ -2330,9 +2391,13 @@ type FSharpSymbolUse(g:TcGlobals, denv: DisplayEnv, symbol:FSharpSymbol, itemOcc // custom builders, custom operations get colored as keywords | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use -> true | _ -> false + member __.IsFromOpenStatement = itemOcc = ItemOccurence.Open + member __.FileName = range.FileName + member __.Range = Range.toZ range + member __.RangeAlternate = range override __.ToString() = sprintf "%O, %O, %O" symbol itemOcc range diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 730c60e79ee7..a6cf492c4d66 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -13,11 +13,10 @@ open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.NameResolution // Implementation details used by other code in the compiler -module internal Impl = - type internal cenv = - new : TcGlobals * thisCcu:CcuThunk * tcImports: TcImports -> cenv - member amap: Import.ImportMap - member g: TcGlobals +type internal SymbolEnv = + new : TcGlobals * thisCcu:CcuThunk * thisCcuTyp: ModuleOrNamespaceType option * tcImports: TcImports -> SymbolEnv + member amap: Import.ImportMap + member g: TcGlobals /// Indicates the accessibility of a symbol, as seen by the F# language type public FSharpAccessibility = @@ -52,7 +51,7 @@ type [] public FSharpDisplayContext = /// or FSharpActivePatternCase. type [] public FSharpSymbol = /// Internal use only. - static member internal Create : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * item:NameResolution.Item -> FSharpSymbol + static member internal Create : g:TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * item:NameResolution.Item -> FSharpSymbol /// Computes if the symbol is accessible for the given accessibility rights member IsAccessible: FSharpAccessibilityRights -> bool @@ -121,7 +120,7 @@ and [] public FSharpAssembly = /// Represents an inferred signature of part of an assembly as seen by the F# language and [] public FSharpAssemblySignature = - internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature + internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature /// The (non-nested) module and type definitions in this signature member Entities: IList @@ -138,11 +137,11 @@ and [] public FSharpAssemblySignature = and [] public FSharpEntity = inherit FSharpSymbol - internal new : Impl.cenv * EntityRef -> FSharpEntity - - // /// Return the FSharpEntity corresponding to a .NET type - // static member FromType : System.Type -> FSharpEntity + internal new : SymbolEnv * EntityRef -> FSharpEntity + /// Get the enclosing entity for the definition + member DeclaringEntity : FSharpEntity option + /// Get the name of the type or module, possibly with `n mangling member LogicalName: string @@ -344,7 +343,7 @@ and [] public FSharpAbstractParameter = /// Represents the signature of an abstract slot of a class or interface and [] public FSharpAbstractSignature = - internal new : Impl.cenv * SlotSig -> FSharpAbstractSignature + internal new : SymbolEnv * SlotSig -> FSharpAbstractSignature /// Get the arguments of the abstract slot member AbstractArguments : IList> @@ -367,7 +366,7 @@ and [] public FSharpAbstractSignature = /// A subtype of FSharpSymbol that represents a union case as seen by the F# language and [] public FSharpUnionCase = inherit FSharpSymbol - internal new : Impl.cenv * UnionCaseRef -> FSharpUnionCase + internal new : SymbolEnv * UnionCaseRef -> FSharpUnionCase /// Get the name of the union case member Name: string @@ -405,8 +404,8 @@ and [] public FSharpUnionCase = and [] public FSharpField = inherit FSharpSymbol - internal new : Impl.cenv * RecdFieldRef -> FSharpField - internal new : Impl.cenv * UnionCaseRef * int -> FSharpField + internal new : SymbolEnv * RecdFieldRef -> FSharpField + internal new : SymbolEnv * UnionCaseRef * int -> FSharpField /// Get the declaring entity of this field member DeclaringEntity: FSharpEntity @@ -472,7 +471,7 @@ and [] public FSharpAccessibilityRights = and [] public FSharpGenericParameter = inherit FSharpSymbol - internal new : Impl.cenv * Typar -> FSharpGenericParameter + internal new : SymbolEnv * Typar -> FSharpGenericParameter /// Get the name of the generic parameter member Name: string @@ -642,8 +641,8 @@ and [] public FSharpInlineAnnotation = and [] public FSharpMemberOrFunctionOrValue = inherit FSharpSymbol - internal new : Impl.cenv * ValRef -> FSharpMemberOrFunctionOrValue - internal new : Impl.cenv * Infos.MethInfo -> FSharpMemberOrFunctionOrValue + internal new : SymbolEnv * ValRef -> FSharpMemberOrFunctionOrValue + internal new : SymbolEnv * Infos.MethInfo -> FSharpMemberOrFunctionOrValue /// Indicates if the member, function or value is in an unresolved assembly member IsUnresolved : bool @@ -896,8 +895,8 @@ and [] public FSharpActivePatternGroup = and [] public FSharpType = /// Internal use only. Create a ground type. - internal new : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * typ:TType -> FSharpType - internal new : Impl.cenv * typ:TType -> FSharpType + internal new : g:TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * typ:TType -> FSharpType + internal new : SymbolEnv * typ:TType -> FSharpType /// Indicates this is a named type in an unresolved assembly member IsUnresolved : bool @@ -996,21 +995,25 @@ and [] public FSharpAttribute = member Format : context: FSharpDisplayContext -> string /// Represents open declaration in F# code. +[] type public FSharpOpenDeclaration = - { /// Idents. - LongId: Ident list + + internal new : longId: Ident list * range: range option * modules: FSharpEntity list * appliedScope: range * isOwnNamespace: bool -> FSharpOpenDeclaration + + /// Idents. + member LongId: Ident list - /// Range of the open declaration. - Range: range option + /// Range of the open declaration. + member Range: range option - /// Modules or namespaces which is opened with this declaration. - Modules: FSharpEntity list + /// Modules or namespaces which is opened with this declaration. + member Modules: FSharpEntity list - /// Scope in which open declaration is visible. - AppliedScope: range + /// Scope in which open declaration is visible. + member AppliedScope: range - /// If it's `namespace Xxx.Yyy` declaration. - IsOwnNamespace: bool } + /// If it's `namespace Xxx.Yyy` declaration. + member IsOwnNamespace: bool /// Represents the use of an F# symbol from F# source code [] diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index cca16b60a455..186eab895c96 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -398,7 +398,6 @@ assert (sizeof = 8) assert (sizeof = 4) #endif - let unassignedTyparName = "?" exception UndefinedName of int * (* error func that expects identifier name *)(string -> string) * Ident * ErrorLogger.Suggestions @@ -425,6 +424,24 @@ type ModuleOrNamespaceKind = +let getNameOfScopeRef sref = + match sref with + | ILScopeRef.Local -> "" + | ILScopeRef.Module mref -> mref.Name + | ILScopeRef.Assembly aref -> aref.Name + +#if !NO_EXTENSIONTYPING +let ComputeDefinitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvider>) = + let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure(id))) + match attrs with + | None | Some (null, _, _) -> None + | Some (filePath, line, column) -> + // Coordinates from type provider are 1-based for lines and columns + // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns + let pos = Range.mkPos line (max 0 (column - 1)) + Range.mkRange filePath pos pos |> Some + +#endif /// A public path records where a construct lives within the global namespace /// of a CCU. @@ -465,26 +482,6 @@ type CompilationPath = -let getNameOfScopeRef sref = - match sref with - | ILScopeRef.Local -> "" - | ILScopeRef.Module mref -> mref.Name - | ILScopeRef.Assembly aref -> aref.Name - - -#if !NO_EXTENSIONTYPING -let ComputeDefinitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvider>) = - let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure(id))) - match attrs with - | None | Some (null, _, _) -> None - | Some (filePath, line, column) -> - // Coordinates from type provider are 1-based for lines and columns - // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns - let pos = Range.mkPos line (max 0 (column - 1)) - Range.mkRange filePath pos pos |> Some - -#endif - type EntityOptionalData = { /// The name of the type, possibly with `n mangling @@ -524,6 +521,9 @@ type EntityOptionalData = mutable entity_exn_info: ExceptionInfo } + override x.ToString() = "EntityOptionalData(...)" + + and /// Represents a type definition, exception definition, module definition or namespace definition. [] Entity = @@ -950,8 +950,6 @@ and /// Represents a type definition, exception definition, module definition or /// Indicates if the entity is linked to backing data. Only used during unpickling of F# metadata. member x.IsLinked = match box x.entity_attribs with null -> false | _ -> true - override x.ToString() = x.LogicalName - /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. member x.FSharpObjectModelTypeInfo = match x.TypeReprInfo with @@ -1161,19 +1159,24 @@ and /// Represents a type definition, exception definition, module definition or /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) + override x.ToString() = x.LogicalName + and [] MaybeLazy<'T> = | Strict of 'T | Lazy of Lazy<'T> + member this.Value : 'T = match this with | Strict x -> x | Lazy x -> x.Value + member this.Force() : 'T = match this with | Strict x -> x | Lazy x -> x.Force() and EntityData = Entity + and ParentRef = | Parent of EntityRef | ParentNone @@ -1244,6 +1247,9 @@ and tcaug_interfaces=[] tcaug_closed=false tcaug_abstract=false } + + override x.ToString() = "TyconAugmentation(...)" + and [] /// The information for the contents of a type. Also used for a provided namespace. @@ -1289,10 +1295,16 @@ and /// The information for exception definitions should be folded into here. | TNoRepr + override x.ToString() = "TyconRepresentation(...)" + and [] /// TILObjectReprData(scope, nesting, definition) - TILObjectReprData = TILObjectReprData of ILScopeRef * ILTypeDef list * ILTypeDef + TILObjectReprData = + | TILObjectReprData of ILScopeRef * ILTypeDef list * ILTypeDef + + override x.ToString() = "TILObjectReprData(...)" + #if !NO_EXTENSIONTYPING and @@ -1300,51 +1312,55 @@ and /// The information kept about a provided type TProvidedTypeInfo = - { /// The parameters given to the provider that provided to this type. - ResolutionEnvironment : ExtensionTyping.ResolutionEnvironment + { /// The parameters given to the provider that provided to this type. + ResolutionEnvironment : ExtensionTyping.ResolutionEnvironment + + /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on + /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting + /// error messages) + ProvidedType: Tainted - /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on - /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting - /// error messages) - ProvidedType: Tainted + /// The base type of the type. We use it to compute the compiled representation of the type for erased types. + /// Reading is delayed, since it does an import on the underlying type + LazyBaseType: LazyWithContext - /// The base type of the type. We use it to compute the compiled representation of the type for erased types. - /// Reading is delayed, since it does an import on the underlying type - LazyBaseType: LazyWithContext + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsClass: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsClass: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsSealed: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsSealed: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsInterface: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsInterface: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsStructOrEnum: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsStructOrEnum: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsEnum: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsEnum: bool - /// A type read from the provided type and used to compute basic properties of the type definition. - /// Reading is delayed, since it does an import on the underlying type - UnderlyingTypeOfEnum: (unit -> TType) + /// A type read from the provided type and used to compute basic properties of the type definition. + /// Reading is delayed, since it does an import on the underlying type + UnderlyingTypeOfEnum: (unit -> TType) - /// A flag read from the provided type and used to compute basic properties of the type definition. - /// Reading is delayed, since it looks at the .BaseType - IsDelegate: (unit -> bool) + /// A flag read from the provided type and used to compute basic properties of the type definition. + /// Reading is delayed, since it looks at the .BaseType + IsDelegate: (unit -> bool) - /// Indicates the type is erased - IsErased: bool + /// Indicates the type is erased + IsErased: bool - /// Indicates the type is generated, but type-relocation is suppressed - IsSuppressRelocate : bool } + /// Indicates the type is generated, but type-relocation is suppressed + IsSuppressRelocate : bool } - member info.IsGenerated = not info.IsErased - member info.BaseTypeForErased (m,objTy) = + member info.IsGenerated = not info.IsErased + + member info.BaseTypeForErased (m,objTy) = if info.IsErased then info.LazyBaseType.Force (m,objTy) else assert false; failwith "expect erased type" + override x.ToString() = "TProvidedTypeInfo(...)" + #endif and @@ -1381,6 +1397,8 @@ and /// The fields of the class, struct or enum fsobjmodel_rfields: TyconRecdFields } + override x.ToString() = "TyconObjModelData(...)" + and [] TyconRecdFields = @@ -1395,10 +1413,15 @@ and else failwith "FieldByIndex" member x.FieldByName n = x.FieldsByName.TryFind(n) + member x.AllFieldsAsList = x.FieldsByIndex |> Array.toList + member x.TrueFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsCompilerGenerated) + member x.TrueInstanceFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsStatic && not f.IsCompilerGenerated) + override x.ToString() = "TyconRecdFields(...)" + and [] TyconUnionCases = @@ -1413,6 +1436,8 @@ and member x.UnionCasesAsList = x.CasesByIndex |> Array.toList + override x.ToString() = "TyconUnionCases(...)" + and [] TyconUnionData = @@ -1421,8 +1446,11 @@ and /// The ILX data structure representing the discriminated union. CompiledRepresentation: IlxUnionRef cache } + member x.UnionCasesAsList = x.CasesTable.CasesByIndex |> Array.toList + override x.ToString() = "TyconUnionData(...)" + and [] [] @@ -1470,11 +1498,17 @@ and | _ -> uc.Range member uc.DisplayName = uc.Id.idText + member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex + member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList + member uc.GetFieldByName nm = uc.FieldTable.FieldByName nm + member uc.IsNullary = (uc.FieldTable.FieldsByIndex.Length = 0) + override x.ToString() = "UnionCase(" + x.DisplayName + ")" + and /// This may represent a "field" in either a struct, class, record or union /// It is normally compiled to a property. @@ -1590,6 +1624,8 @@ and | Some Const.Zero -> true | _ -> false + override x.ToString() = "RecdField(" + x.Name + ")" + and ExceptionInfo = /// Indicates that an exception is an abbreviation for the given exception | TExnAbbrevRepr of TyconRef @@ -1603,177 +1639,178 @@ and ExceptionInfo = /// Indicates that an exception is abstract, i.e. is in a signature file, and we do not know the representation | TExnNone -and - [] - ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, entities: QueueList) = + override x.ToString() = "ExceptionInfo(...)" - /// Mutation used during compilation of FSharp.Core.dll - let mutable entities = entities +and [] ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, entities: QueueList) = + + /// Mutation used during compilation of FSharp.Core.dll + let mutable entities = entities - // Lookup tables keyed the way various clients expect them to be keyed. - // We attach them here so we don't need to store lookup tables via any other technique. - // - // The type option ref is used because there are a few functions that treat these as first class values. - // We should probably change to 'mutable'. - // - // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. - let activePatternElemRefCache : NameMap option ref = ref None - let modulesByDemangledNameCache : NameMap option ref = ref None - let exconsByDemangledNameCache : NameMap option ref = ref None - let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None - let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None - let tyconsByMangledNameCache : NameMap option ref = ref None - let allEntitiesByMangledNameCache : NameMap option ref = ref None - let allValsAndMembersByPartialLinkageKeyCache : MultiMap option ref = ref None - let allValsByLogicalNameCache : NameMap option ref = ref None + // Lookup tables keyed the way various clients expect them to be keyed. + // We attach them here so we don't need to store lookup tables via any other technique. + // + // The type option ref is used because there are a few functions that treat these as first class values. + // We should probably change to 'mutable'. + // + // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. + let activePatternElemRefCache : NameMap option ref = ref None + let modulesByDemangledNameCache : NameMap option ref = ref None + let exconsByDemangledNameCache : NameMap option ref = ref None + let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None + let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None + let tyconsByMangledNameCache : NameMap option ref = ref None + let allEntitiesByMangledNameCache : NameMap option ref = ref None + let allValsAndMembersByPartialLinkageKeyCache : MultiMap option ref = ref None + let allValsByLogicalNameCache : NameMap option ref = ref None - /// Namespace or module-compiled-as-type? - member mtyp.ModuleOrNamespaceKind = kind + /// Namespace or module-compiled-as-type? + member mtyp.ModuleOrNamespaceKind = kind - /// Values, including members in F# types in this module-or-namespace-fragment. - member mtyp.AllValsAndMembers = vals + /// Values, including members in F# types in this module-or-namespace-fragment. + member mtyp.AllValsAndMembers = vals - /// Type, mapping mangled name to Tycon, e.g. - //// "Dictionary`2" --> Tycon - //// "ListModule" --> Tycon with module info - //// "FooException" --> Tycon with exception info - member mtyp.AllEntities = entities + /// Type, mapping mangled name to Tycon, e.g. + //// "Dictionary`2" --> Tycon + //// "ListModule" --> Tycon with module info + //// "FooException" --> Tycon with exception info + member mtyp.AllEntities = entities - /// Mutation used during compilation of FSharp.Core.dll - member mtyp.AddModuleOrNamespaceByMutation(modul:ModuleOrNamespace) = - entities <- QueueList.appendOne entities modul - modulesByDemangledNameCache := None - allEntitiesByMangledNameCache := None + /// Mutation used during compilation of FSharp.Core.dll + member mtyp.AddModuleOrNamespaceByMutation(modul:ModuleOrNamespace) = + entities <- QueueList.appendOne entities modul + modulesByDemangledNameCache := None + allEntitiesByMangledNameCache := None #if !NO_EXTENSIONTYPING - /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace - member mtyp.AddProvidedTypeEntity(entity:Entity) = - entities <- QueueList.appendOne entities entity - tyconsByMangledNameCache := None - tyconsByDemangledNameAndArityCache := None - tyconsByAccessNamesCache := None - allEntitiesByMangledNameCache := None + /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace + member mtyp.AddProvidedTypeEntity(entity:Entity) = + entities <- QueueList.appendOne entities entity + tyconsByMangledNameCache := None + tyconsByDemangledNameAndArityCache := None + tyconsByAccessNamesCache := None + allEntitiesByMangledNameCache := None #endif - /// Return a new module or namespace type with an entity added. - member mtyp.AddEntity(tycon:Tycon) = - ModuleOrNamespaceType(kind, vals, entities.AppendOne tycon) + /// Return a new module or namespace type with an entity added. + member mtyp.AddEntity(tycon:Tycon) = + ModuleOrNamespaceType(kind, vals, entities.AppendOne tycon) - /// Return a new module or namespace type with a value added. - member mtyp.AddVal(vspec:Val) = - ModuleOrNamespaceType(kind, vals.AppendOne vspec, entities) + /// Return a new module or namespace type with a value added. + member mtyp.AddVal(vspec:Val) = + ModuleOrNamespaceType(kind, vals.AppendOne vspec, entities) - /// Get a table of the active patterns defined in this module. - member mtyp.ActivePatternElemRefLookupTable = activePatternElemRefCache + /// Get a table of the active patterns defined in this module. + member mtyp.ActivePatternElemRefLookupTable = activePatternElemRefCache - /// Get a list of types defined within this module, namespace or type. - member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of types defined within this module, namespace or type. + member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList - /// Get a list of F# exception definitions defined within this module, namespace or type. - member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList + /// Get a list of F# exception definitions defined within this module, namespace or type. + member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList - /// Get a list of module and namespace definitions defined within this module, namespace or type. - member mtyp.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of module and namespace definitions defined within this module, namespace or type. + member mtyp.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList - /// Get a list of type and exception definitions defined within this module, namespace or type. - member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of type and exception definitions defined within this module, namespace or type. + member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList - /// Get a table of types defined within this module, namespace or type. The - /// table is indexed by both name and generic arity. This means that for generic - /// types "List`1", the entry (List,1) will be present. - member mtyp.TypesByDemangledNameAndArity m = + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name and generic arity. This means that for generic + /// types "List`1", the entry (List,1) will be present. + member mtyp.TypesByDemangledNameAndArity m = cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc:Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) - /// Get a table of types defined within this module, namespace or type. The - /// table is indexed by both name and, for generic types, also by mangled name. - member mtyp.TypesByAccessNames = - cacheOptRef tyconsByAccessNamesCache (fun () -> + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name and, for generic types, also by mangled name. + member mtyp.TypesByAccessNames = + cacheOptRef tyconsByAccessNamesCache (fun () -> LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc:Tycon) -> KeyTyconByAccessNames tc.LogicalName tc))) - // REVIEW: we can remove this lookup and use AllEntitiedByMangledName instead? - member mtyp.TypesByMangledName = - let addTyconByMangledName (x:Tycon) tab = NameMap.add x.LogicalName x tab - cacheOptRef tyconsByMangledNameCache (fun () -> + // REVIEW: we can remove this lookup and use AllEntitiedByMangledName instead? + member mtyp.TypesByMangledName = + let addTyconByMangledName (x:Tycon) tab = NameMap.add x.LogicalName x tab + cacheOptRef tyconsByMangledNameCache (fun () -> List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) - /// Get a table of entities indexed by both logical and compiled names - member mtyp.AllEntitiesByCompiledAndLogicalMangledNames : NameMap = - let addEntityByMangledName (x:Entity) tab = - let name1 = x.LogicalName - let name2 = x.CompiledName - let tab = NameMap.add name1 x tab - if name1 = name2 then tab - else NameMap.add name2 x tab + /// Get a table of entities indexed by both logical and compiled names + member mtyp.AllEntitiesByCompiledAndLogicalMangledNames : NameMap = + let addEntityByMangledName (x:Entity) tab = + let name1 = x.LogicalName + let name2 = x.CompiledName + let tab = NameMap.add name1 x tab + if name1 = name2 then tab + else NameMap.add name2 x tab - cacheOptRef allEntitiesByMangledNameCache (fun () -> + cacheOptRef allEntitiesByMangledNameCache (fun () -> QueueList.foldBack addEntityByMangledName entities Map.empty) - /// Get a table of entities indexed by both logical name - member mtyp.AllEntitiesByLogicalMangledName : NameMap = - let addEntityByMangledName (x:Entity) tab = NameMap.add x.LogicalName x tab - QueueList.foldBack addEntityByMangledName entities Map.empty - - /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), - /// and the method argument count (if any). - member mtyp.AllValsAndMembersByPartialLinkageKey = - let addValByMangledName (x:Val) tab = - if x.IsCompiledAsTopLevel then - MultiMap.add x.LinkagePartialKey x tab - else - tab - cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> + /// Get a table of entities indexed by both logical name + member mtyp.AllEntitiesByLogicalMangledName : NameMap = + let addEntityByMangledName (x:Entity) tab = NameMap.add x.LogicalName x tab + QueueList.foldBack addEntityByMangledName entities Map.empty + + /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), + /// and the method argument count (if any). + member mtyp.AllValsAndMembersByPartialLinkageKey = + let addValByMangledName (x:Val) tab = + if x.IsCompiledAsTopLevel then + MultiMap.add x.LinkagePartialKey x tab + else + tab + cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> QueueList.foldBack addValByMangledName vals MultiMap.empty) - /// Try to find the member with the given linkage key in the given module. - member mtyp.TryLinkVal(ccu:CcuThunk,key:ValLinkageFullKey) = - mtyp.AllValsAndMembersByPartialLinkageKey - |> MultiMap.find key.PartialKey - |> List.tryFind (fun v -> match key.TypeForLinkage with - | None -> true - | Some keyTy -> ccu.MemberSignatureEquality(keyTy,v.Type)) - |> ValueOption.ofOption - - /// Get a table of values indexed by logical name - member mtyp.AllValsByLogicalName = - let addValByName (x:Val) tab = - // Note: names may occur twice prior to raising errors about this in PostTypeCheckSemanticChecks - // Earlier ones take precedence since we report errors about the later ones - if not x.IsMember && not x.IsCompilerGenerated then - NameMap.add x.LogicalName x tab - else - tab - cacheOptRef allValsByLogicalNameCache (fun () -> - QueueList.foldBack addValByName vals Map.empty) - - /// Compute a table of values and members indexed by logical name. - member mtyp.AllValsAndMembersByLogicalNameUncached = - let addValByName (x:Val) tab = - if not x.IsCompilerGenerated then - MultiMap.add x.LogicalName x tab - else - tab - QueueList.foldBack addValByName vals MultiMap.empty - - /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' - member mtyp.ExceptionDefinitionsByDemangledName = - let add (tycon:Tycon) acc = NameMap.add tycon.LogicalName tycon acc - cacheOptRef exconsByDemangledNameCache (fun () -> - List.foldBack add mtyp.ExceptionDefinitions Map.empty) - - /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') - member mtyp.ModulesAndNamespacesByDemangledName = - let add (entity:Entity) acc = - if entity.IsModuleOrNamespace then - NameMap.add entity.DemangledModuleOrNamespaceName entity acc - else acc - cacheOptRef modulesByDemangledNameCache (fun () -> - QueueList.foldBack add entities Map.empty) + /// Try to find the member with the given linkage key in the given module. + member mtyp.TryLinkVal(ccu:CcuThunk,key:ValLinkageFullKey) = + mtyp.AllValsAndMembersByPartialLinkageKey + |> MultiMap.find key.PartialKey + |> List.tryFind (fun v -> match key.TypeForLinkage with + | None -> true + | Some keyTy -> ccu.MemberSignatureEquality(keyTy,v.Type)) + |> ValueOption.ofOption + + /// Get a table of values indexed by logical name + member mtyp.AllValsByLogicalName = + let addValByName (x:Val) tab = + // Note: names may occur twice prior to raising errors about this in PostTypeCheckSemanticChecks + // Earlier ones take precedence since we report errors about the later ones + if not x.IsMember && not x.IsCompilerGenerated then + NameMap.add x.LogicalName x tab + else + tab + cacheOptRef allValsByLogicalNameCache (fun () -> + QueueList.foldBack addValByName vals Map.empty) + + /// Compute a table of values and members indexed by logical name. + member mtyp.AllValsAndMembersByLogicalNameUncached = + let addValByName (x:Val) tab = + if not x.IsCompilerGenerated then + MultiMap.add x.LogicalName x tab + else + tab + QueueList.foldBack addValByName vals MultiMap.empty + + /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' + member mtyp.ExceptionDefinitionsByDemangledName = + let add (tycon:Tycon) acc = NameMap.add tycon.LogicalName tycon acc + cacheOptRef exconsByDemangledNameCache (fun () -> + List.foldBack add mtyp.ExceptionDefinitions Map.empty) + + /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') + member mtyp.ModulesAndNamespacesByDemangledName = + let add (entity:Entity) acc = + if entity.IsModuleOrNamespace then + NameMap.add entity.DemangledModuleOrNamespaceName entity acc + else acc + cacheOptRef modulesByDemangledNameCache (fun () -> + QueueList.foldBack add entities Map.empty) + + override x.ToString() = "ModuleOrNamespaceType(...)" and ModuleOrNamespace = Entity and Tycon = Entity - /// A set of static methods for constructing types. and Construct = @@ -1900,6 +1937,8 @@ and Accessibility = /// Indicates the construct can only be accessed from any code in the given type constructor, module or assembly. [] indicates global scope. | TAccess of CompilationPath list + override x.ToString() = "Accessibility(...)" + and TyparData = Typar and [] @@ -2055,14 +2094,19 @@ and /// Sets the rigidity of a type variable member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable is compiler generated member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable has a static requirement member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable is required at runtime member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b , flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether the equality constraint of a type definition depends on this type variable member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b , flags.ComparisonConditionalOn) + /// Sets whether the comparison constraint of a type definition depends on this type variable member x.SetComparisonDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) @@ -2111,6 +2155,8 @@ and /// Indicates a constraint that a type is .NET unmanaged type | IsUnmanaged of range + + override x.ToString() = "TyparConstraint(...)" /// The specification of a member constraint that must be solved and @@ -2125,12 +2171,16 @@ and /// Get the member name associated with the member constraint. member x.MemberName = (let (TTrait(_,nm,_,_,_,_)) = x in nm) + /// Get the return type recorded in the member constraint. member x.ReturnType = (let (TTrait(_,_,_,_,ty,_)) = x in ty) + /// Get or set the solution of the member constraint during inference member x.Solution with get() = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value) and set v = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value <- v) + + override x.ToString() = "TTrait(" + x.MemberName + ")" and [] @@ -2170,6 +2220,8 @@ and /// Indicates a trait is solved by a 'fake' instance of an operator, like '+' on integers | BuiltInSln + override x.ToString() = "TraitConstraintSln(...)" + /// The partial information used to index the methods of all those in a ModuleOrNamespace. and [] ValLinkagePartialKey = @@ -2185,6 +2237,8 @@ and [] /// Indicates the total argument count of the member. TotalArgCount: int } + override x.ToString() = "ValLinkagePartialKey(" + x.LogicalName + ")" + /// The full information used to identify a specific overloaded method /// amongst all those in a ModuleOrNamespace. and ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType option) = @@ -2195,6 +2249,8 @@ and ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType op /// The full type of the value for the purposes of linking. May be None for non-members, since they can't be overloaded. member x.TypeForLinkage = typeForLinkage + override x.ToString() = "ValLinkageFullKey(" + partialKey.LogicalName + ")" + and ValOptionalData = { /// MUTABILITY: for unpickle linkage @@ -2246,19 +2302,21 @@ and ValOptionalData = mutable val_attribs: Attribs } + override x.ToString() = "ValOptionalData(...)" + and ValData = Val and [] Val = { - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_logical_name: string - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_range: range mutable val_type: TType - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_stamp: Stamp /// See vflags section further below for encoding/decodings here @@ -2337,7 +2395,6 @@ and [] /// 'let x = let y = 1 in y + y' (NOTE: check this, don't take it as gospel) member x.IsCompiledAsTopLevel = x.ValReprInfo.IsSome - /// The partial information used to index the methods of all those in a ModuleOrNamespace. member x.LinkagePartialKey : ValLinkagePartialKey = assert x.IsCompiledAsTopLevel @@ -2606,14 +2663,13 @@ and [] else givenName - - /// - If this is a property then this is 'Foo' - /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot + /// The name of the property. + /// - If this is a property then this is 'Foo' + /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot member x.PropertyName = let logicalName = x.LogicalName ChopPropertyName logicalName - /// The name of the method. /// - If this is a property then this is 'Foo' /// - If this is an implementation of an abstract slot then this is the name of the method implemented by the abstract slot @@ -2637,32 +2693,44 @@ and [] DemangleOperatorName x.CoreDisplayName member x.SetValRec b = x.val_flags <- x.val_flags.SetRecursiveValInfo b + member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.SetIsMemberOrModuleBinding + member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.SetMakesNoCriticalTailcalls + member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.SetHasBeenReferenced + member x.SetIsCompiledAsStaticPropertyWithoutField() = x.val_flags <- x.val_flags.SetIsCompiledAsStaticPropertyWithoutField + member x.SetIsFixed() = x.val_flags <- x.val_flags.SetIsFixed + member x.SetValReprInfo info = match x.val_opt_data with | Some optData -> optData.val_repr_info <- info | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_repr_info = info } + member x.SetType ty = x.val_type <- ty + member x.SetOtherRange m = match x.val_opt_data with | Some optData -> optData.val_other_range <- Some m | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_other_range = Some m } + member x.SetDeclaringEntity parent = match x.val_opt_data with | Some optData -> optData.val_declaring_entity <- parent | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_declaring_entity = parent } + member x.SetAttribs attribs = match x.val_opt_data with | Some optData -> optData.val_attribs <- attribs | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_attribs = attribs } + member x.SetMemberInfo member_info = match x.val_opt_data with | Some optData -> optData.val_member_info <- Some member_info | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_member_info = Some member_info } + member x.SetValDefn val_defn = match x.val_opt_data with | Some optData -> optData.val_defn <- Some val_defn @@ -2702,6 +2770,7 @@ and [] and + /// Represents the extra information stored for a member [] ValMemberInfo = { /// The parent type. For an extension member this is the type being extended @@ -2715,6 +2784,7 @@ and MemberFlags: MemberFlags } + override x.ToString() = "ValMemberInfo(...)" and [] @@ -2725,9 +2795,16 @@ and /// The name of the value, or the full signature of the member ItemKey: ValLinkageFullKey } + /// Get the thunk for the assembly referred to member x.Ccu = x.EnclosingEntity.nlr.Ccu + + /// Get the name of the assembly referred to member x.AssemblyName = x.EnclosingEntity.nlr.AssemblyName + + /// For debugging member x.Display = x.ToString() + + /// For debugging override x.ToString() = x.EnclosingEntity.nlr.ToString() + "::" + x.ItemKey.PartialKey.LogicalName and ValPublicPath = @@ -4386,9 +4463,10 @@ and SlotParam = member x.Type = let (TSlotParam(_,ty,_,_,_,_)) = x in ty /// A type for a module-or-namespace-fragment and the actual definition of the module-or-namespace-fragment +/// The first ModuleOrNamespaceType is the signature and is a binder. However the bindings are not used in the ModuleOrNamespaceExpr: it is only referenced from the 'outside' +/// is for use by FCS only to report the "hidden" contents of the assembly prior to applying the signature. and ModuleOrNamespaceExprWithSig = | ModuleOrNamespaceExprWithSig of - /// The ModuleOrNamespaceType is a binder. However it is not used in the ModuleOrNamespaceExpr: it is only referenced from the 'outside' ModuleOrNamespaceType * ModuleOrNamespaceExpr * range @@ -4398,20 +4476,25 @@ and ModuleOrNamespaceExprWithSig = and ModuleOrNamespaceExpr = /// Indicates the module is a module with a signature | TMAbstract of ModuleOrNamespaceExprWithSig + /// Indicates the module fragment is made of several module fragments in succession | TMDefs of ModuleOrNamespaceExpr list + /// Indicates the module fragment is a 'let' definition | TMDefLet of Binding * range + /// Indicates the module fragment is an evaluation of expression for side-effects | TMDefDo of Expr * range + /// Indicates the module fragment is a 'rec' or 'non-rec' definition of types and modules | TMDefRec of isRec:bool * Tycon list * ModuleOrNamespaceBinding list * range /// A named module-or-namespace-fragment definition and [] ModuleOrNamespaceBinding = - //| Do of Expr + | Binding of Binding + | Module of /// This ModuleOrNamespace that represents the compilation of a module as a class. /// The same set of tycons etc. are bound in the ModuleOrNamespace as in the ModuleOrNamespaceExpr diff --git a/src/scripts/scriptlib.fsx b/src/scripts/scriptlib.fsx index c2ace2163545..79481efb7c60 100644 --- a/src/scripts/scriptlib.fsx +++ b/src/scripts/scriptlib.fsx @@ -36,7 +36,7 @@ module Scripting = #if INTERACTIVE let argv = Microsoft.FSharp.Compiler.Interactive.Settings.fsi.CommandLineArgs |> Seq.skip 1 |> Seq.toArray - let getCmdLineArgOptional switchName = + let getCmdLineArgOptional (switchName: string) = argv |> Array.filter(fun t -> t.StartsWith(switchName)) |> Array.map(fun t -> t.Remove(0, switchName.Length).Trim()) |> Array.tryHead let getCmdLineArg switchName defaultValue = diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 15435406b9b2..325bc04635ac 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -2672,6 +2672,30 @@ let ``Test Project16 sym locations`` () = ("val x", ("file1", (11, 11), (11, 12)), ("file1", (11, 11), (11, 12)),("file1", (11, 11), (11, 12))); ("Impl", ("sig1", (2, 7), (2, 11)), ("file1", (2, 7), (2, 11)),("file1", (2, 7), (2, 11)))|] +[] +let ``Test project16 DeclaringEntity`` () = + let wholeProjectResults = + checker.ParseAndCheckProject(Project16.options) + |> Async.RunSynchronously + let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously + for sym in allSymbolsUses do + match sym.Symbol with + | :? FSharpEntity as e when not e.IsNamespace || e.AccessPath.Contains(".") -> + printfn "checking declaring type of entity '%s' --> '%s', assembly = '%s'" e.AccessPath e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome (e.AccessPath <> "global") + match e.AccessPath with + | "C" | "D" | "E" | "F" | "G" -> + shouldEqual e.AccessPath "Impl" + shouldEqual e.DeclaringEntity.Value.IsFSharpModule true + shouldEqual e.DeclaringEntity.Value.IsNamespace false + | "int" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Core" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + | _ -> () + | :? FSharpMemberOrFunctionOrValue as e when e.IsModuleValueOrMember -> + printfn "checking declaring type of value '%s', assembly = '%s'" e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + | _ -> () //----------------------------------------------------------------------------------------- @@ -4636,7 +4660,7 @@ module internal Project37 = let projFileName = Path.ChangeExtension(base2, ".fsproj") let fileSource1 = """ namespace AttrTests - +type X = int list [] type AttrTestAttribute() = inherit System.Attribute() @@ -4665,6 +4689,8 @@ module Test = let withTypeArray = 0 [] let withIntArray = 0 + module NestedModule = + type NestedRecordType = { B : int } [] do () @@ -4722,21 +4748,56 @@ let ``Test project37 typeof and arrays in attribute constructor arguments`` () = a |> shouldEqual [| 0; 1; 2 |] | _ -> () | _ -> () - wholeProjectResults.AssemblySignature.Attributes - |> Seq.map (fun a -> a.AttributeType.CompiledName) - |> Array.ofSeq |> shouldEqual [| "AttrTestAttribute"; "AttrTest2Attribute" |] - - wholeProjectResults.ProjectContext.GetReferencedAssemblies() - |> Seq.find (fun a -> a.SimpleName = "mscorlib") - |> fun a -> - printfn "Attributes found in mscorlib: %A" a.Contents.Attributes - shouldEqual (a.Contents.Attributes.Count > 0) true - - wholeProjectResults.ProjectContext.GetReferencedAssemblies() - |> Seq.find (fun a -> a.SimpleName = "FSharp.Core") - |> fun a -> - printfn "Attributes found in FSharp.Core: %A" a.Contents.Attributes - shouldEqual (a.Contents.Attributes.Count > 0) true + + let mscorlibAsm = + wholeProjectResults.ProjectContext.GetReferencedAssemblies() + |> Seq.find (fun a -> a.SimpleName = "mscorlib") + printfn "Attributes found in mscorlib: %A" mscorlibAsm.Contents.Attributes + shouldEqual (mscorlibAsm.Contents.Attributes.Count > 0) true + + let fsharpCoreAsm = + wholeProjectResults.ProjectContext.GetReferencedAssemblies() + |> Seq.find (fun a -> a.SimpleName = "FSharp.Core") + printfn "Attributes found in FSharp.Core: %A" fsharpCoreAsm.Contents.Attributes + shouldEqual (fsharpCoreAsm.Contents.Attributes.Count > 0) true + +[] +let ``Test project37 DeclaringEntity`` () = + let wholeProjectResults = + checker.ParseAndCheckProject(Project37.options) + |> Async.RunSynchronously + let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously + for sym in allSymbolsUses do + match sym.Symbol with + | :? FSharpEntity as e when not e.IsNamespace || e.AccessPath.Contains(".") -> + printfn "checking declaring type of entity '%s' --> '%s', assembly = '%s'" e.AccessPath e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + match e.CompiledName with + | "AttrTestAttribute" -> + shouldEqual e.AccessPath "AttrTests" + | "int" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Core" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + | "list`1" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Collections" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.IsSome true + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.IsNamespace true + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "Microsoft" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.IsSome false + | "Attribute" -> + shouldEqual e.AccessPath "System" + shouldEqual e.DeclaringEntity.Value.AccessPath "global" + | "NestedRecordType" -> + shouldEqual e.AccessPath "AttrTests.Test.NestedModule" + shouldEqual e.DeclaringEntity.Value.AccessPath "AttrTests.Test" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "AttrTests" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "global" + | _ -> () + | :? FSharpMemberOrFunctionOrValue as e when e.IsModuleValueOrMember -> + printfn "checking declaring type of value '%s', assembly = '%s'" e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + | _ -> () //----------------------------------------------------------- From 284cb2ff115adb8ff5b1febe1c305a10c933172e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 29 Mar 2018 11:11:15 +0100 Subject: [PATCH 06/24] perf results --- tests/scripts/compiler-perf-results.txt | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/tests/scripts/compiler-perf-results.txt b/tests/scripts/compiler-perf-results.txt index 46e50507e7ce..f8fd0b24922b 100644 --- a/tests/scripts/compiler-perf-results.txt +++ b/tests/scripts/compiler-perf-results.txt @@ -133,8 +133,14 @@ https://github.com/manofstick/visualfsharp.git all-your-collections-are-belong-t https://github.com/manofstick/visualfsharp.git all-your-collections-are-belong-to-us 87dafbc17b494c438b6db9e59e064736bd8a44e2 7e1fd6ac330f86597f3167e8067cfd805a89eec9 MSRC-DON-OFFICE 235.48 10.83 33.47 47.17 65.56 52.50 https://github.com/dsyme/visualfsharp.git weak1 58bd2bec78f01e57fecff604146a3cc55eec4966 221224e6d20bd835c2b9e01e0a52bf45e740a8d0 MSRC-3617253 260.05 10.97 30.78 47.15 58.04 59.77 +https://github.com/dsyme/visualfsharp.git weak2 35b7e2caed9b81e2ceb9de9f325ddeb550bf97d6 4df997507226caa272f2c7d4fbdc52eb71c8ead2 MSRC-3617253 257.26 11.24 30.62 48.03 57.80 57.60 + https://github.com/dsyme/visualfsharp.git range1 e49ac8a2f21223e60d0d9597e52ea9e5f8705963 221224e6d20bd835c2b9e01e0a52bf45e740a8d0 MSRC-3617253 275.83 12.79 32.57 53.38 61.94 58.03 +https://github.com/dsyme/visualfsharp.git range1 46be8bee06180324b63a3b808cf4a90492a5f095 ff078e94deff66e548efb668465fcdd601cc158d MSRC-3617253 265.13 10.57 35.61 48.73 59.07 59.03 + https://github.com/Microsoft/visualfsharp master 221224e6d20bd835c2b9e01e0a52bf45e740a8d0 221224e6d20bd835c2b9e01e0a52bf45e740a8d0 MSRC-3617253 273.00 12.46 32.80 51.38 60.93 58.66 -https://github.com/dsyme/visualfsharp.git weak2 35b7e2caed9b81e2ceb9de9f325ddeb550bf97d6 4df997507226caa272f2c7d4fbdc52eb71c8ead2 MSRC-3617253 257.26 11.24 30.62 48.03 57.80 57.60 -https://github.com/Microsoft/visualfsharp master 4df997507226caa272f2c7d4fbdc52eb71c8ead2 4df997507226caa272f2c7d4fbdc52eb71c8ead2 MSRC-3617253 254.53 11.55 31.80 46.58 57.03 58.89 -https://github.com/Microsoft/visualfsharp master 65d87f0b2ee67e50503540aad5d4438fdde14fea 65d87f0b2ee67e50503540aad5d4438fdde14fea MSRC-3617253 257.92 10.44 32.62 45.45 56.68 58.53 +https://github.com/Microsoft/visualfsharp master 4df997507226caa272f2c7d4fbdc52eb71c8ead2 4df997507226caa272f2c7d4fbdc52eb71c8ead2 MSRC-3617253 254.53 11.55 31.80 46.58 57.03 58.89 +https://github.com/Microsoft/visualfsharp master 65d87f0b2ee67e50503540aad5d4438fdde14fea 65d87f0b2ee67e50503540aad5d4438fdde14fea MSRC-3617253 257.92 10.44 32.62 45.45 56.68 58.53 +https://github.com/Microsoft/visualfsharp master ff078e94deff66e548efb668465fcdd601cc158d ff078e94deff66e548efb668465fcdd601cc158d MSRC-3617253 262.60 10.60 34.99 47.73 59.08 58.46 + +https://github.com/AviAvni/visualfsharp.git fcs-memory-3 d91dbc81ce304a88a4e3c07032781421c71e3bab ff078e94deff66e548efb668465fcdd601cc158d MSRC-3617253 263.83 10.70 35.24 47.30 59.09 59.14 From d222eadf2b1bda9d1dd4aedf9183644978fa84ea Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Thu, 29 Mar 2018 12:53:58 -0700 Subject: [PATCH 07/24] ensure reference alias is set before csc is invoked --- .../Project/ProjectSystem.Base.csproj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj index f2e30ac08ad3..48032c8e15b8 100644 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj +++ b/vsintegration/src/FSharp.ProjectSystem.Base/Project/ProjectSystem.Base.csproj @@ -72,13 +72,13 @@ - + - + From 20b6f6b62f6911006bc37449ef52c3cbe8090fc0 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Fri, 30 Mar 2018 12:25:00 -0700 Subject: [PATCH 08/24] Converted FSharpEditorFactory and TextViewCreationListener to F# and moved it to FSharp.Editor; fixed alt+enter for script files (#4625) --- .../Commands/FsiCommandService.fs | 14 +- .../src/FSharp.Editor/Common/Constants.fs | 4 + .../src/FSharp.Editor/FSharp.Editor.fsproj | 2 + .../LanguageService/FSharpEditorFactory.fs | 118 +++++++++++++++ .../LanguageService/LanguageService.fs | 116 +++++++++----- .../TextViewCreationListener.fs | 63 ++++++++ .../Project/Constants.cs | 14 -- .../Project/FSharpEditorFactory.cs | 142 ------------------ .../Project/TextViewCreationListener.cs | 84 ----------- .../MenusAndCommands.vsct | 60 ++++---- .../FSharp.ProjectSystem.FSharp/Project.fs | 61 ++------ vsintegration/src/FSharp.VS.FSI/fsiBasis.fs | 5 + .../src/FSharp.VS.FSI/fsiLanguageService.fs | 26 +--- .../src/FSharp.VS.FSI/fsiSessionToolWindow.fs | 4 +- 14 files changed, 326 insertions(+), 387 deletions(-) create mode 100644 vsintegration/src/FSharp.Editor/LanguageService/FSharpEditorFactory.fs create mode 100644 vsintegration/src/FSharp.Editor/LanguageService/TextViewCreationListener.fs delete mode 100644 vsintegration/src/FSharp.ProjectSystem.Base/Project/Constants.cs delete mode 100644 vsintegration/src/FSharp.ProjectSystem.Base/Project/FSharpEditorFactory.cs delete mode 100644 vsintegration/src/FSharp.ProjectSystem.Base/Project/TextViewCreationListener.cs diff --git a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs index 86c6284d590a..389d50b3cbac 100644 --- a/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/FsiCommandService.fs @@ -17,15 +17,17 @@ open Microsoft.VisualStudio.FSharp.Interactive type internal FsiCommandFilter(serviceProvider: System.IServiceProvider) = - let projectSystemPackage = + let loadPackage (guidString: string) = lazy( let shell = serviceProvider.GetService(typeof) :?> IVsShell - let packageToBeLoadedGuid = ref (Guid "{91a04a73-4f2c-4e7c-ad38-c1a68e7da05c}") // FSharp ProjectSystem guid + let packageToBeLoadedGuid = ref (Guid(guidString)) match shell.LoadPackage packageToBeLoadedGuid with | VSConstants.S_OK, pkg -> pkg :?> Package | _ -> null) + let fsiPackage = loadPackage FSharpConstants.fsiPackageGuidString + let mutable nextTarget = null member x.AttachToViewAdapter (viewAdapter: IVsTextView) = @@ -38,13 +40,13 @@ type internal FsiCommandFilter(serviceProvider: System.IServiceProvider) = interface IOleCommandTarget with member x.Exec (pguidCmdGroup, nCmdId, nCmdexecopt, pvaIn, pvaOut) = if pguidCmdGroup = VSConstants.VsStd11 && nCmdId = uint32 VSConstants.VSStd11CmdID.ExecuteSelectionInInteractive then - Hooks.OnMLSend projectSystemPackage.Value FsiEditorSendAction.ExecuteSelection null null + Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.ExecuteSelection null null VSConstants.S_OK elif pguidCmdGroup = VSConstants.VsStd11 && nCmdId = uint32 VSConstants.VSStd11CmdID.ExecuteLineInInteractive then - Hooks.OnMLSend projectSystemPackage.Value FsiEditorSendAction.ExecuteLine null null + Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.ExecuteLine null null VSConstants.S_OK elif pguidCmdGroup = Guids.guidInteractive && nCmdId = uint32 Guids.cmdIDDebugSelection then - Hooks.OnMLSend projectSystemPackage.Value FsiEditorSendAction.DebugSelection null null + Hooks.OnMLSend fsiPackage.Value FsiEditorSendAction.DebugSelection null null VSConstants.S_OK elif not (isNull nextTarget) then nextTarget.Exec(&pguidCmdGroup, nCmdId, nCmdexecopt, pvaIn, pvaOut) @@ -62,7 +64,7 @@ type internal FsiCommandFilter(serviceProvider: System.IServiceProvider) = elif pguidCmdGroup = Guids.guidInteractive then for i = 0 to int cCmds-1 do if prgCmds.[i].cmdID = uint32 Guids.cmdIDDebugSelection then - let dbgState = Hooks.GetDebuggerState projectSystemPackage.Value + let dbgState = Hooks.GetDebuggerState fsiPackage.Value if dbgState = FsiDebuggerState.AttachedNotToFSI then prgCmds.[i].cmdf <- uint32 OLECMDF.OLECMDF_INVISIBLE else diff --git a/vsintegration/src/FSharp.Editor/Common/Constants.fs b/vsintegration/src/FSharp.Editor/Common/Constants.fs index ec876ff9d5e4..b2ca8e560545 100644 --- a/vsintegration/src/FSharp.Editor/Common/Constants.fs +++ b/vsintegration/src/FSharp.Editor/Common/Constants.fs @@ -10,6 +10,10 @@ module internal FSharpConstants = [] /// "871D2A70-12A2-4e42-9440-425DD92A4116" let packageGuidString = "871D2A70-12A2-4e42-9440-425DD92A4116" + + [] + /// "871D2A70-12A2-4e42-9440-425DD92A4116" - FSharp Package + let fsiPackageGuidString = "871D2A70-12A2-4e42-9440-425DD92A4116" [] /// "BC6DD5A5-D4D6-4dab-A00D-A51242DBAF1B" diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index eb29d4d0df94..744c8449115a 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -38,6 +38,8 @@ + + diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpEditorFactory.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpEditorFactory.fs new file mode 100644 index 000000000000..cadf0d33e062 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpEditorFactory.fs @@ -0,0 +1,118 @@ +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Runtime.InteropServices +open Microsoft.VisualStudio +open Microsoft.VisualStudio.Editor +open Microsoft.VisualStudio.Shell +open Microsoft.VisualStudio.Shell.Interop +open Microsoft.VisualStudio.TextManager.Interop +open Microsoft.VisualStudio.Utilities +open Microsoft.VisualStudio.ComponentModelHost + +type ShellPackage = Microsoft.VisualStudio.Shell.Package + +[] +module Constants = + + [] + let FSharpEditorFactoryIdString = "8a5aa6cf-46e3-4520-a70a-7393d15233e9" + + [] + let FSharpContentType = "F#" + + // _VSPHYSICALVIEWATTRIBUTES.PVA_SupportsPreview = 2 + // F# doesn't allow to express a cast of an enum as a literal; we have to put the number here directly. + [] + let FSharpEditorFactoryPhysicalViewAttributes = 2 + +[] +type FSharpEditorFactory(parentPackage: ShellPackage) = + + let serviceProvider = + if parentPackage = null then + nullArg "parentPackage" + parentPackage :> IServiceProvider + let componentModel = serviceProvider.GetService(typeof) :?> IComponentModel + let editorAdaptersFactoryService = componentModel.GetService() + let contentTypeRegistryService = componentModel.GetService() + + let setWindowBuffer oleServiceProvider (textBuffer: IVsTextBuffer) (ppunkDocView: byref) (ppunkDocData: byref) (pbstrEditorCaption: byref) = + // If the text buffer is marked as read-only, ensure that the padlock icon is displayed + // next the new window's title and that [Read Only] is appended to title. + let readOnlyFlags = + (BUFFERSTATEFLAGS.BSF_FILESYS_READONLY ||| BUFFERSTATEFLAGS.BSF_USER_READONLY) + |> LanguagePrimitives.EnumToValue + |> uint32 + + let mutable textBufferFlags = 0u + let readOnlyStatus = + if (ErrorHandler.Succeeded(textBuffer.GetStateFlags(&textBufferFlags)) && 0u <> (textBufferFlags &&& readOnlyFlags)) then + READONLYSTATUS.ROSTATUS_ReadOnly + else + READONLYSTATUS.ROSTATUS_NotReadOnly + + let codeWindow = editorAdaptersFactoryService.CreateVsCodeWindowAdapter(oleServiceProvider); + codeWindow.SetBuffer(textBuffer :?> IVsTextLines) + |> ignore + codeWindow.GetEditorCaption(readOnlyStatus, &pbstrEditorCaption) + |> ignore + + ppunkDocView <- Marshal.GetIUnknownForObject(codeWindow); + ppunkDocData <- Marshal.GetIUnknownForObject(textBuffer); + + VSConstants.S_OK; + + let mutable oleServiceProviderOpt = None + + interface IVsEditorFactory with + + member __.Close() = VSConstants.S_OK + + member __.CreateEditorInstance(_grfCreateDoc, _pszMkDocument, _pszPhysicalView, _pvHier, _itemid, punkDocDataExisting, ppunkDocView, ppunkDocData, pbstrEditorCaption, pguidCmdUI, pgrfCDW) = + ppunkDocView <- IntPtr.Zero + ppunkDocData <- IntPtr.Zero + pbstrEditorCaption <- String.Empty + + //pguidCmdUI is the highest priority Guid that Visual Studio Shell looks at when translating key strokes into editor commands. + //Here we intentionally set it to Guid.Empty so it will not play a part in translating keystrokes at all. The next highest priority + //will be commands tied to this FSharpEditorFactory (such as Alt-Enter). + //However, because we are setting pguidCmdUI, we are not going to get typical text editor commands bound to this editor unless we inherit + //those keybindings on the IVsWindowFrame in which our editor lives. + pguidCmdUI <- Guid.Empty + pgrfCDW <- 0 + + match oleServiceProviderOpt with + | None -> VSConstants.E_FAIL + | Some oleServiceProvider -> + // Is this document already open? If so, let's see if it's a IVsTextBuffer we should re-use. This allows us + // to properly handle multiple windows open for the same document. + if punkDocDataExisting <> IntPtr.Zero then + match Marshal.GetObjectForIUnknown(punkDocDataExisting) with + | :? IVsTextBuffer as textBuffer -> + setWindowBuffer oleServiceProvider textBuffer &ppunkDocView &ppunkDocData &pbstrEditorCaption + | _ -> + VSConstants.VS_E_INCOMPATIBLEDOCDATA + else + // We need to create a text buffer now. + let contentType = contentTypeRegistryService.GetContentType(Constants.FSharpContentType) + let textBuffer = editorAdaptersFactoryService.CreateVsTextBufferAdapter(oleServiceProvider, contentType) + setWindowBuffer oleServiceProvider textBuffer &ppunkDocView &ppunkDocData &pbstrEditorCaption + + member __.MapLogicalView(rguidLogicalView, pbstrPhysicalView) = + pbstrPhysicalView <- null + + match rguidLogicalView with + | x when + x = VSConstants.LOGVIEWID.Primary_guid || + x = VSConstants.LOGVIEWID.Debugging_guid || + x = VSConstants.LOGVIEWID.Code_guid || + x = VSConstants.LOGVIEWID.TextView_guid -> + VSConstants.S_OK + | _ -> + VSConstants.E_NOTIMPL + + member __.SetSite(packageServiceProvider) = + oleServiceProviderOpt <- Some packageServiceProvider + VSConstants.S_OK + \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index 06865213827a..8ebd33535e8d 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -9,6 +9,7 @@ open System.Collections.Concurrent open System.Collections.Generic open System.Collections.Immutable open System.ComponentModel.Composition +open System.ComponentModel.Design open System.Diagnostics open System.IO open System.Linq @@ -305,53 +306,96 @@ type internal FSharpCheckerWorkspaceServiceFactory member this.Checker = checkerProvider.Checker member this.FSharpProjectOptionsManager = projectInfoManager } -type - [] - [, "F#", null, "IntelliSense", "6008")>] - [, "F#", null, "QuickInfo", "6009")>] - [, "F#", null, "Code Fixes", "6010")>] - [, "F#", null, "Performance", "6011")>] - [, "F#", null, "Advanced", "6012")>] - [] - [, - strLanguageName = FSharpConstants.FSharpLanguageName, - languageResourceID = 100, - MatchBraces = true, - MatchBracesAtCaret = true, - ShowCompletion = true, - ShowMatchingBrace = true, - ShowSmartIndent = true, - EnableAsyncCompletion = true, - QuickInfo = true, - DefaultToInsertSpaces = true, - CodeSense = true, - DefaultToNonHotURLs = true, - RequestStockColors = true, - EnableCommenting = true, - CodeSenseDelay = 100, - ShowDropDownOptions = true)>] - internal FSharpPackage() = +[] +[, + "F# Tools", "F# Interactive", // category/sub-category on Tools>Options... + 6000s, 6001s, // resource id for localisation of the above + true)>] // true = supports automation +[] // <-- resource ID for localised name +[, + // The following should place the ToolWindow with the OutputWindow by default. + Orientation=ToolWindowOrientation.Bottom, + Style=VsDockStyle.Tabbed, + PositionX = 0, + PositionY = 0, + Width = 360, + Height = 120, + Window="34E76E81-EE4A-11D0-AE2E-00A0C90FFFC3")>] +[, "F#", null, "IntelliSense", "6008")>] +[, "F#", null, "QuickInfo", "6009")>] +[, "F#", null, "Code Fixes", "6010")>] +[, "F#", null, "Performance", "6011")>] +[, "F#", null, "Advanced", "6012")>] +[] +// 64 represents a hex number. It needs to be greater than 37 so the TextMate editor will not be chosen as higher priority. +[, ".fs", 64)>] +[, ".fsi", 64)>] +[, ".fsscript", 64)>] +[, ".fsx", 64)>] +[, ".ml", 64)>] +[, ".mli", 64)>] +[, 101s, CommonPhysicalViewAttributes = Constants.FSharpEditorFactoryPhysicalViewAttributes)>] +[, ".fs")>] +[, ".fsi")>] +[, ".fsx")>] +[, ".fsscript")>] +[, ".ml")>] +[, ".mli")>] +[, + strLanguageName = FSharpConstants.FSharpLanguageName, + languageResourceID = 100, + MatchBraces = true, + MatchBracesAtCaret = true, + ShowCompletion = true, + ShowMatchingBrace = true, + ShowSmartIndent = true, + EnableAsyncCompletion = true, + QuickInfo = true, + DefaultToInsertSpaces = true, + CodeSense = true, + DefaultToNonHotURLs = true, + RequestStockColors = true, + EnableCommenting = true, + CodeSenseDelay = 100, + ShowDropDownOptions = true)>] +type internal FSharpPackage() as this = inherit AbstractPackage() + let mutable vfsiToolWindow = Unchecked.defaultof + let GetToolWindowAsITestVFSI() = + if vfsiToolWindow = Unchecked.defaultof<_> then + vfsiToolWindow <- this.FindToolWindow(typeof, 0, true) :?> Microsoft.VisualStudio.FSharp.Interactive.FsiToolWindow + vfsiToolWindow :> Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI + + // FSI-LINKAGE-POINT: unsited init + do Microsoft.VisualStudio.FSharp.Interactive.Hooks.fsiConsoleWindowPackageCtorUnsited (this :> Package) + override this.Initialize() = base.Initialize() + this.ComponentModel.GetService() |> ignore + // FSI-LINKAGE-POINT: sited init + let commandService = this.GetService(typeof) :?> OleMenuCommandService // FSI-LINKAGE-POINT + Microsoft.VisualStudio.FSharp.Interactive.Hooks.fsiConsoleWindowPackageInitalizeSited (this :> Package) commandService + // FSI-LINKAGE-POINT: private method GetDialogPage forces fsi options to be loaded + let _fsiPropertyPage = this.GetDialogPage(typeof) + () + override this.RoslynLanguageName = FSharpConstants.FSharpLanguageName override this.CreateWorkspace() = this.ComponentModel.GetService() override this.CreateLanguageService() = FSharpLanguageService(this) - override this.CreateEditorFactories() = Seq.empty + override this.CreateEditorFactories() = seq { yield FSharpEditorFactory(this) :> IVsEditorFactory } override this.RegisterMiscellaneousFilesWorkspaceInformation(_) = () -type - [] - [, ".fs")>] - [, ".fsi")>] - [, ".fsx")>] - [, ".fsscript")>] - [, ".ml")>] - [, ".mli")>] - internal FSharpLanguageService(package : FSharpPackage) = + interface Microsoft.VisualStudio.FSharp.Interactive.ITestVFSI with + member this.SendTextInteraction(s:string) = + GetToolWindowAsITestVFSI().SendTextInteraction(s) + member this.GetMostRecentLines(n:int) : string[] = + GetToolWindowAsITestVFSI().GetMostRecentLines(n) + +[] +type internal FSharpLanguageService(package : FSharpPackage) = inherit AbstractLanguageService(package) let projectInfoManager = package.ComponentModel.DefaultExportProvider.GetExport().Value diff --git a/vsintegration/src/FSharp.Editor/LanguageService/TextViewCreationListener.fs b/vsintegration/src/FSharp.Editor/LanguageService/TextViewCreationListener.fs new file mode 100644 index 000000000000..8dae5999bbcd --- /dev/null +++ b/vsintegration/src/FSharp.Editor/LanguageService/TextViewCreationListener.fs @@ -0,0 +1,63 @@ +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Runtime.InteropServices +open System.ComponentModel.Composition; +open Microsoft.VisualStudio +open Microsoft.VisualStudio.Editor +open Microsoft.VisualStudio.Shell +open Microsoft.VisualStudio.Shell.Interop +open Microsoft.VisualStudio.TextManager.Interop +open Microsoft.VisualStudio.Utilities +open Microsoft.VisualStudio.ComponentModelHost +open Microsoft.VisualStudio.Text.Editor +open Microsoft.VisualStudio.OLE.Interop + +[)>] +[] +[] +type TextViewCreationListener [] (adaptersFactory: IVsEditorAdaptersFactoryService) = + + /// + /// The initializes the pguidCmdUI to an empty Guid. This means that our buffer does not receive the normal text editor command bindings. + /// In order to handle this, we tell the IVsWindowFrame in which our editor lives to inherit the keybindinds from the text editor factory. + /// This allows us to specify the TextEditor keybindings at a lower priority than our F# Editor Factory keybindings and allows us to handle Alt+Enter + /// + let initKeyBindings (vsTextView: IVsTextView) = + match vsTextView with + | :? IObjectWithSite as os -> + let mutable unkSite = IntPtr.Zero + let mutable unkFrame = IntPtr.Zero + + try + os.GetSite(ref typeof.GUID, &unkSite) + let sp = Marshal.GetObjectForIUnknown(unkSite) :?> IServiceProvider + + sp.QueryService(ref typeof.GUID, ref typeof.GUID, &unkFrame) + |> ignore + + //When calling Peek Definition, the editor creates an IVsTextView within another view. + //Therefore this new view won't exist as the direct child of an IVsWindowFrame and we will return. + //We don't need to worry about inheriting key bindings in this situation, because the + //parent IVsTextView will have already set this value during its creation. + if unkFrame <> IntPtr.Zero then + let frame = Marshal.GetObjectForIUnknown(unkFrame) :?> IVsWindowFrame + frame.SetGuidProperty(LanguagePrimitives.EnumToValue __VSFPROPID.VSFPROPID_InheritKeyBindings, ref VSConstants.GUID_TextEditorFactory) + |> ignore + + finally + if unkSite <> IntPtr.Zero then + Marshal.Release(unkSite) + |> ignore + + if unkFrame <> IntPtr.Zero then + Marshal.Release(unkFrame) + |> ignore + + | _ -> () + + interface IVsTextViewCreationListener with + + member __.VsTextViewCreated(textViewAdapter) = + let _textView = adaptersFactory.GetWpfTextView(textViewAdapter) + initKeyBindings textViewAdapter \ No newline at end of file diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Constants.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/Constants.cs deleted file mode 100644 index 211d0aa16577..000000000000 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/Constants.cs +++ /dev/null @@ -1,14 +0,0 @@ -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Microsoft.VisualStudio.FSharp.ProjectSystem -{ - internal static class Constants - { - public const string FSharpEditorFactoryIdString = "8a5aa6cf-46e3-4520-a70a-7393d15233e9"; - public const string FSharpContentType = "F#"; - } -} diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/FSharpEditorFactory.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/FSharpEditorFactory.cs deleted file mode 100644 index bb27865b5ba7..000000000000 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/FSharpEditorFactory.cs +++ /dev/null @@ -1,142 +0,0 @@ -using Microsoft.VisualStudio; -using Microsoft.VisualStudio.ComponentModelHost; -using Microsoft.VisualStudio.Designer.Interfaces; -using Microsoft.VisualStudio.Editor; -using Microsoft.VisualStudio.Shell; -using Microsoft.VisualStudio.Shell.Interop; -using Microsoft.VisualStudio.TextManager.Interop; -using Microsoft.VisualStudio.Utilities; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Runtime.InteropServices; -using System.Text; -using System.Threading.Tasks; -using IOleServiceProvider = Microsoft.VisualStudio.OLE.Interop.IServiceProvider; -using ShellPackage = Microsoft.VisualStudio.Shell.Package; - -namespace Microsoft.VisualStudio.FSharp.ProjectSystem -{ - // 64 represents a hex number. It needs to be greater than 37 so the TextMate editor will not be chosen as higher priority. - [Guid(Constants.FSharpEditorFactoryIdString)] - [ProvideEditorFactory(typeof(FSharpEditorFactory), 101, CommonPhysicalViewAttributes = (int)__VSPHYSICALVIEWATTRIBUTES.PVA_SupportsPreview)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".fs", 64)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".fsi", 64)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".fsscript", 64)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".fsx", 64)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".ml", 64)] - [ProvideEditorExtension(typeof(FSharpEditorFactory), ".mli", 64)] - public class FSharpEditorFactory : IVsEditorFactory - { - private ShellPackage _parentPackage; - private IOleServiceProvider _oleServiceProvider; - private IVsEditorAdaptersFactoryService _editorAdaptersFactoryService; - private IContentTypeRegistryService _contentTypeRegistryService; - private IComponentModel _componentModel; - - private IServiceProvider ServiceProvider - { - get - { - return _parentPackage; - } - } - - public FSharpEditorFactory(ShellPackage parentPackage) - { - if (parentPackage == null) - { - throw new ArgumentNullException(nameof(parentPackage)); - } - - _parentPackage = parentPackage; - _componentModel = (IComponentModel)ServiceProvider.GetService(typeof(SComponentModel)); - _editorAdaptersFactoryService = _componentModel.GetService(); - _contentTypeRegistryService = _componentModel.GetService(); - } - - public int Close() - { - return VSConstants.S_OK; - } - - public int CreateEditorInstance(uint grfCreateDoc, string pszMkDocument, string pszPhysicalView, IVsHierarchy pvHier, uint itemid, IntPtr punkDocDataExisting, out IntPtr ppunkDocView, out IntPtr ppunkDocData, out string pbstrEditorCaption, out Guid pguidCmdUI, out int pgrfCDW) - { - ppunkDocView = IntPtr.Zero; - ppunkDocData = IntPtr.Zero; - pbstrEditorCaption = String.Empty; - - //pguidCmdUI is the highest priority Guid that Visual Studio Shell looks at when translating key strokes into editor commands. - //Here we intentionally set it to Guid.Empty so it will not play a part in translating keystrokes at all. The next highest priority - //will be commands tied to this FSharpEditorFactory (such as Alt-Enter). - //However, because we are setting pguidCmdUI, we are not going to get typical text editor commands bound to this editor unless we inherit - //those keybindings on the IVsWindowFrame in which our editor lives. - pguidCmdUI = Guid.Empty; - pgrfCDW = 0; - - IVsTextBuffer textBuffer = null; - - // Is this document already open? If so, let's see if it's a IVsTextBuffer we should re-use. This allows us - // to properly handle multiple windows open for the same document. - if (punkDocDataExisting != IntPtr.Zero) - { - object docDataExisting = Marshal.GetObjectForIUnknown(punkDocDataExisting); - - textBuffer = docDataExisting as IVsTextBuffer; - - if (textBuffer == null) - { - // We are incompatible with the existing doc data - return VSConstants.VS_E_INCOMPATIBLEDOCDATA; - } - } - - // Do we need to create a text buffer? - if (textBuffer == null) - { - var contentType = _contentTypeRegistryService.GetContentType(Constants.FSharpContentType); - textBuffer = _editorAdaptersFactoryService.CreateVsTextBufferAdapter(_oleServiceProvider, contentType); - } - - // If the text buffer is marked as read-only, ensure that the padlock icon is displayed - // next the new window's title and that [Read Only] is appended to title. - READONLYSTATUS readOnlyStatus = READONLYSTATUS.ROSTATUS_NotReadOnly; - uint textBufferFlags; - if (ErrorHandler.Succeeded(textBuffer.GetStateFlags(out textBufferFlags)) && - 0 != (textBufferFlags & ((uint)BUFFERSTATEFLAGS.BSF_FILESYS_READONLY | (uint)BUFFERSTATEFLAGS.BSF_USER_READONLY))) - { - readOnlyStatus = READONLYSTATUS.ROSTATUS_ReadOnly; - } - - var codeWindow = _editorAdaptersFactoryService.CreateVsCodeWindowAdapter(_oleServiceProvider); - codeWindow.SetBuffer((IVsTextLines)textBuffer); - codeWindow.GetEditorCaption(readOnlyStatus, out pbstrEditorCaption); - - ppunkDocView = Marshal.GetIUnknownForObject(codeWindow); - ppunkDocData = Marshal.GetIUnknownForObject(textBuffer); - - return VSConstants.S_OK; - } - - public int MapLogicalView(ref Guid rguidLogicalView, out string pbstrPhysicalView) - { - pbstrPhysicalView = null; - - if(rguidLogicalView == VSConstants.LOGVIEWID.Primary_guid || - rguidLogicalView == VSConstants.LOGVIEWID.Debugging_guid || - rguidLogicalView == VSConstants.LOGVIEWID.Code_guid || - rguidLogicalView == VSConstants.LOGVIEWID.TextView_guid) - { - return VSConstants.S_OK; - } - - return VSConstants.E_NOTIMPL; - } - - public int SetSite(Microsoft.VisualStudio.OLE.Interop.IServiceProvider packageServiceProvider) - { - _oleServiceProvider = packageServiceProvider; - return VSConstants.S_OK; - } - } -} diff --git a/vsintegration/src/FSharp.ProjectSystem.Base/Project/TextViewCreationListener.cs b/vsintegration/src/FSharp.ProjectSystem.Base/Project/TextViewCreationListener.cs deleted file mode 100644 index c0b443475bdb..000000000000 --- a/vsintegration/src/FSharp.ProjectSystem.Base/Project/TextViewCreationListener.cs +++ /dev/null @@ -1,84 +0,0 @@ -using Microsoft.VisualStudio.Editor; -using Microsoft.VisualStudio.Utilities; -using System; -using System.Collections.Generic; -using System.ComponentModel.Composition; -using System.Linq; -using System.Text; -using System.Threading.Tasks; -using Microsoft.VisualStudio.TextManager.Interop; -using System.Runtime.InteropServices; -using Microsoft.VisualStudio.Shell.Interop; -using Microsoft.VisualStudio.OLE.Interop; -using Microsoft.VisualStudio.Text.Editor; - -namespace Microsoft.VisualStudio.FSharp.ProjectSystem -{ - [Export(typeof(IVsTextViewCreationListener))] - [ContentType(Constants.FSharpContentType)] - [TextViewRole(PredefinedTextViewRoles.Editable)] - public class TextViewCreationListener : IVsTextViewCreationListener - { - internal readonly IVsEditorAdaptersFactoryService _adaptersFactory; - - [ImportingConstructor] - public TextViewCreationListener(IVsEditorAdaptersFactoryService adaptersFactory) - { - _adaptersFactory = adaptersFactory; - } - - public void VsTextViewCreated(IVsTextView textViewAdapter) - { - var textView = _adaptersFactory.GetWpfTextView(textViewAdapter); - InitKeyBindings(textViewAdapter); - } - - /// - /// The initializes the pguidCmdUI to an empty Guid. This means that our buffer does not receive the normal text editor command bindings. - /// In order to handle this, we tell the IVsWindowFrame in which our editor lives to inherit the keybindinds from the text editor factory. - /// This allows us to specify the TextEditor keybindings at a lower priority than our F# Editor Factory keybindings and allows us to handle Alt+Enter - /// - public void InitKeyBindings(IVsTextView vsTextView) - { - var os = vsTextView as IObjectWithSite; - if (os == null) - { - return; - } - - IntPtr unkSite = IntPtr.Zero; - IntPtr unkFrame = IntPtr.Zero; - - try - { - os.GetSite(typeof(VisualStudio.OLE.Interop.IServiceProvider).GUID, out unkSite); - var sp = Marshal.GetObjectForIUnknown(unkSite) as VisualStudio.OLE.Interop.IServiceProvider; - - sp.QueryService(typeof(SVsWindowFrame).GUID, typeof(IVsWindowFrame).GUID, out unkFrame); - - //When calling Peek Definition, the editor creates an IVsTextView within another view. - //Therefore this new view won't exist as the direct child of an IVsWindowFrame and we will return. - //We don't need to worry about inheriting key bindings in this situation, because the - //parent IVsTextView will have already set this value during its creation. - if(unkFrame == IntPtr.Zero) - { - return; - } - - var frame = Marshal.GetObjectForIUnknown(unkFrame) as IVsWindowFrame; - frame.SetGuidProperty((int)__VSFPROPID.VSFPROPID_InheritKeyBindings, VSConstants.GUID_TextEditorFactory); - } - finally - { - if (unkSite != IntPtr.Zero) - { - Marshal.Release(unkSite); - } - if (unkFrame != IntPtr.Zero) - { - Marshal.Release(unkFrame); - } - } - } - } -} diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/MenusAndCommands.vsct b/vsintegration/src/FSharp.ProjectSystem.FSharp/MenusAndCommands.vsct index 5ec9f586dd0b..4a95e4cfcfc6 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/MenusAndCommands.vsct +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/MenusAndCommands.vsct @@ -94,35 +94,7 @@ - - - - - - - - - - - - - - - Add &Below - Add &Below - Add &Below - - - - - - Add &Above - Add &Above - Add &Above - - - + + + + + + + + + + + + + + + + Add &Below + Add &Below + Add &Below + + + + + + Add &Above + Add &Above + Add &Above + + + +