From 531cd5b8ca83fb4d774c6636ac0f5efbf292e416 Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Tue, 10 Oct 2017 23:15:13 -0700 Subject: [PATCH 1/5] merge master into vs-rtm2017 (#3728) * Generate source for .resx files on build. (#3607) * add build task to generate *.fs from *.resx files * generate source for embedded resources in tests * generate source for embedded resources in FSharp.Editor * generate source for embedded resources in FSharp.LanguageService * generate source for embedded resources in FSharp.ProjectSystem.FSharp * generate source for embedded resources in FSharp.VS.FSI * don't generate non-string resources when <=netstandard1.6 * update baseline error message for tests The error output should be the exception message, not the exception type. * perform up-to-date check before generating *.fs from *.resx * remove non-idiomatic fold for an array comprehension * correct newline replacement * output more friendly error message * throw if boolean value isn't explicitly `true` or `false` * only generate object resource code on non `netstandard1.*` and `netcoreapp1.*` platforms * ensure FSharp.Core specifies a target framework for resource generaton * rename attributes to be non-ambiguous and properly include them * fix order of file items in FSharp.Core * Fix build.cmd for certain always-shown errors (like "unable to find registry key"), improve finding of VS2017 tools, fix DEVGUIDE.md (#3635) * Fix build.com displaying the following error on each run "ERROR: The system was unable to find the specified registry key or value." * Remove warning about reg.exe errors introduced in #3614 (in commit b548bd7, but unrelated to that fix), it is no longer necessary. * Fix #3638, VS2017 Preview installation was not found when VS2017RTM is not installed. Remove comment introduced in #3614 (through commit 966bd7f) * Fixing JaroWinkler tests with InvariantCulture and fixing async tests by removing Debugger.Break() (#3627) * Fixing JaroWinkler tests to use InvariantCulture for number-to-string * Fixing the crashing of test runners because of a Debugger.Break() in a test * update to System.Collections.Immutable 1.3.1 (#3641) * update to System.Collections.Immutable 1.3.1 * fixes * fix assembly reference * [WIP] Adds optimized emit for int64 constants (#3620) * Adds optimized emit for int64 constants. * Adds comment linking to the changing PR. Thanks for this PR. Kevin * fix assembly reference (#3646) * Remove a few more build warnings (#3647) * fix assembly reference * remove more build warnings * fix build * move BuildFromSource projects to their own directory * Adds tests for emitted IL for new Int64 constants. (#3650) * Enable FS as prefix and ignore invalid values for warnings (#3631) * enable fs as prefix and ignore invalid values for warnings + tests * Allow #pragma to validate warnings * do it right * use ordinal compare * In both places * Add fs prefix to warnaserror * Fixup tests * Fix stack overflow on assembly resolution (#3658) * Fix stack overflow on tp assembly resolution * Feedback * Add impl files to file check results (#3659) * add LanguageServiceProfiling project to internals visible to list of FSharp.Compiler.Private project * add ImplementationFiles to FSharpCheckFileResults * make FSharpImplementationFileContents ctor internal * throw if ImplementationFiles is called having keepAssemblyContents flag set to false * add a test * spelling and cosmetics * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd (#3672) * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd * Remove ambiguous an irrelevant instruction, improved help and instructions * Fix a scenario where the return code wasn't nonzero for error conditions, fixes not creating backup dir when not backing up * add LanguageServiceProfiling project to internals visible to list of FSharp.Compiler.Private project (#3657) * bump FCS version (#3676) * bump version * Update RELEASE_NOTES.md * Parsing improvements: no reactor, add parsing options, error severity options (#3601) * Parse without reactor, add parsing options, error severity options * Revert parsing APIs (fallback to the new ones), fix VFT projects * Cache parse results after type check * Add impl files to file check results (#3659) * add LanguageServiceProfiling project to internals visible to list of FSharp.Compiler.Private project * add ImplementationFiles to FSharpCheckFileResults * make FSharpImplementationFileContents ctor internal * throw if ImplementationFiles is called having keepAssemblyContents flag set to false * add a test * spelling and cosmetics * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd (#3672) * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd * This adds backup, restore, coloration and many more checks to the update-vsintegration.cmd * Remove ambiguous an irrelevant instruction, improved help and instructions * Fix a scenario where the return code wasn't nonzero for error conditions, fixes not creating backup dir when not backing up * add LanguageServiceProfiling project to internals visible to list of FSharp.Compiler.Private project (#3657) * bump FCS version (#3676) * bump version * Update RELEASE_NOTES.md * updates to make tests pass * restore old behaviour of CheckFileInProjectAllowingStaleCachedResults (builder had been created by ParseFileInProject) * restore use of CheckFileInProjectAllowingStaleCachedResults * deprecate test relying on whacky behaviour of deprecated GetCheckResultsBeforeFileInProjectEvenIfStale * Use ParseFile and FSharpParsingOptions instead of ParseFileInProject * prepare FCS release with this feature * whitespace cleanup (#3682) * whitespace and docs (#3684) * Preserve XML docs for in-memory project references (#3683) * fix xmldocs for in-memory project references * add test * fix tests * whitespace and comments (#3686) * fix assembly reference * whitespace and comments * whitespace and comments * whitespace and comments * cherry pick two PRs from FCS (#3687) * fix assembly reference * remove line endings from all *.nuspec files * ProjectCracker returns *.fsi files in FSharpProjectOptions.SourceFiles array (in addition to *.fs files, in right order) * ProjectCracker raises exception if ProjectCrackerTool returns non null ProjectCrackerOptions.Error (new field) * fix build on linux * fix a test * slashes * revert slashes * Update FSharp.Compiler.Service.ProjectCracker.nuspec * try to fix travis * try to fix travis * list dependencies * no obsolete pdb in nuget * list dependencies * cherry pick of fsharp/fsharp change * bump FCS version number (#3688) * Update FSharp.Compiler.Service.MSBuild.v12.nuspec * fix FCS nuget on windows * fix-resource (#3690) * Bump FSharp.Compiler.Tools to 4.1.27 and align mono build files (#3693) * ri change from fsharp * fix test * bump FSC tools to 4.1.27 * remove fsharp.core from Mono GAC * align mono directory * fix typo * install back versions with Mono * fix typo * update FCS doc generation (#3694) * update DEVGUIDE to add addiitional steps before running build (#3725) * Split templates out into a seperate vsix (#3720) * merge error * Merge issues --- .gitignore | 9 - DEVGUIDE.md | 10 +- FSharp.sln | 13 - Makefile | 127 +-- before_install.sh | 2 +- build.cmd | 54 +- configure.ac | 90 +- ...FSharp.Compiler.Service.MSBuild.v12.fsproj | 2 +- ...arp.Compiler.Service.ProjectCracker.fsproj | 2 +- .../ProjectCracker.fs | 14 +- ...Compiler.Service.ProjectCrackerTool.fsproj | 2 +- .../ProjectCrackerOptions.fs | 1 + .../ProjectCrackerTool.fs | 9 +- fcs/FSharp.Compiler.Service.Tests/App.config | 4 + .../FSharp.Compiler.Service.Tests.fsproj | 10 +- fcs/FSharp.Compiler.Service.sln | 4 +- .../FSharp.Compiler.Service.fsproj | 4 +- fcs/README.md | 6 +- fcs/RELEASE_NOTES.md | 13 +- fcs/build.fsx | 10 +- fcs/docsrc/content/caches.fsx | 9 +- fcs/docsrc/content/corelib.fsx | 12 +- fcs/docsrc/content/editor.fsx | 7 +- fcs/docsrc/content/ja/corelib.fsx | 4 + fcs/docsrc/content/ja/editor.fsx | 8 +- fcs/docsrc/content/ja/untypedtree.fsx | 4 +- fcs/docsrc/content/untypedtree.fsx | 6 +- fcs/docsrc/tools/generate.fsx | 8 +- fcs/docsrc/tools/generate.ja.fsx | 14 +- fcs/fcs.props | 4 +- ...FSharp.Compiler.Service.MSBuild.v12.nuspec | 12 +- ...arp.Compiler.Service.ProjectCracker.nuspec | 16 +- fcs/nuget/FSharp.Compiler.Service.nuspec | 12 +- fcs/paket.dependencies | 2 +- fcs/paket.lock | 10 + fcs/samples/EditorService/App.config | 10 +- .../EditorService/EditorService.fsproj | 4 +- fcs/samples/EditorService/Program.fs | 3 +- fcs/samples/FscExe/App.config | 5 +- fcs/samples/FscExe/FscExe.fsproj | 5 +- fcs/samples/FsiExe/App.config | 5 +- fcs/samples/FsiExe/FsiExe.fsproj | 4 +- fcs/samples/InteractiveService/App.config | 5 +- .../InteractiveService.fsproj | 4 +- fcs/samples/Tokenizer/App.config | 5 +- fcs/samples/Tokenizer/Tokenizer.fsproj | 4 +- fcs/samples/UntypedTree/App.config | 5 +- fcs/samples/UntypedTree/Program.fs | 7 +- fcs/samples/UntypedTree/UntypedTree.fsproj | 4 +- .../Makefile | 2 +- mono/FSharp.Compiler.Server.Shared/Makefile | 2 +- mono/FSharp.Core/Makefile | 2 +- mono/appveyor.ps1 | 3 +- mono/build-netcore.bat | 22 - mono/build.bat | 45 - mono/config.make.in | 74 +- mono/policy.2.0.FSharp.Core/Makefile | 22 - .../policy.2.0.FSharp.Core.dll.config | 17 - mono/policy.2.3.FSharp.Core/Makefile | 22 - .../policy.2.3.FSharp.Core.dll.config | 18 - mono/policy.3.259.FSharp.Core/Makefile | 19 - .../policy.3.259.FSharp.Core.dll.config | 11 - mono/policy.3.3.FSharp.Core/Makefile | 19 - .../policy.3.3.FSharp.Core.dll.config | 11 - mono/policy.3.47.FSharp.Core/Makefile | 19 - .../policy.3.47.FSharp.Core.dll.config | 11 - mono/policy.3.7.FSharp.Core/Makefile | 19 - .../policy.3.7.FSharp.Core.dll.config | 11 - mono/policy.3.78.FSharp.Core/Makefile | 19 - .../policy.3.78.FSharp.Core.dll.config | 11 - mono/policy.4.0.FSharp.Core/Makefile | 19 - .../policy.4.0.FSharp.Core.dll.config | 11 - mono/policy.4.3.FSharp.Core/Makefile | 19 - .../policy.4.3.FSharp.Core.dll.config | 11 - mono/policy.4.4.FSharp.Core/Makefile | 19 - .../policy.4.4.FSharp.Core.dll.config | 11 - mono/prepare-mono.sh | 12 +- mono/travis-autogen.sh | 3 +- packages.config | 16 +- .../component-groups/Compiler_Redist.wxs | 2 +- setup/packages.config | 2 +- src/FSharpSource.Profiles.targets | 1 + src/FSharpSource.Settings.targets | 3 +- src/FSharpSource.targets | 24 +- src/absil/ilascii.fs | 36 +- src/absil/ilprint.fs | 10 +- src/absil/ilread.fs | 984 +++++++++--------- src/absil/ilreflect.fs | 889 ++++++++-------- src/absil/ilwrite.fs | 692 ++++++------ src/absil/ilx.fs | 44 +- ...ssemblyinfo.FSharp.Compiler.Private.dll.fs | 1 + src/buildfromsource.cmd | 4 +- src/buildfromsource.sh | 16 +- .../BuildFromSource.targets} | 17 +- .../FSharp.Build/FSharp.Build.fsproj} | 27 +- ...harp.Compiler.Interactive.Settings.fsproj} | 14 +- .../FSharp.Compiler.Private/.gitignore | 9 + .../FSharp.Compiler.Private.fsproj} | 259 ++--- .../FSharp.Compiler.nuget.fsproj} | 8 +- .../FSharp.Core/FSharp.Core.fsproj} | 120 +-- .../Fsc/Fsc.fsproj} | 17 +- .../Fsi/Fsi.fsproj} | 26 +- src/fsharp/CompileOps.fs | 170 +-- src/fsharp/CompileOps.fsi | 634 ++++++----- src/fsharp/CompileOptions.fs | 81 +- src/fsharp/CompileOptions.fsi | 3 + src/fsharp/ErrorLogger.fs | 116 ++- src/fsharp/ErrorResolutionHints.fs | 10 +- src/fsharp/FSComp.txt | 1 + .../FSharp.Build-proto.fsproj | 4 + src/fsharp/FSharp.Build/FSharp.Build.fsproj | 2 + .../FSharp.Build/FSharpEmbedResXSource.fs | 144 +++ .../FSharp.Build/Microsoft.FSharp.Targets | 18 +- src/fsharp/FSharp.Compiler.Private/.gitignore | 9 + .../FSharp.Compiler.Private.fsproj | 2 +- .../FSharp.Compiler.Private.netcore.nuspec | 2 +- .../FSharp.Compiler.Private/project.json | 2 +- .../FSharp.Compiler.Unittests/EditDistance.fs | 3 +- .../Microsoft.FSharp.Compiler.nuspec | 2 +- .../Testing.FSharp.Compiler.nuspec | 2 +- .../Microsoft.FSharp.Control/AsyncType.fs | 3 +- src/fsharp/FSharp.Core/FSCore.resx | 2 +- src/fsharp/FSharp.Core/FSharp.Core.fsproj | 14 +- src/fsharp/FSharp.Core/Query.fs | 24 +- src/fsharp/FSharp.Core/SR.fs | 7 - src/fsharp/FSharp.Core/prim-types.fs | 2 +- src/fsharp/FSharp.Core/quotations.fs | 24 +- src/fsharp/FSharp.Core/reflect.fs | 38 +- src/fsharp/Fsc-proto/Fsc-proto.fsproj | 7 +- src/fsharp/Fsc-proto/app.config | 11 + src/fsharp/Fsc-proto/fsc-proto.exe.config | 5 - src/fsharp/Fsc/Fsc.fsproj | 5 +- src/fsharp/Fsc/{fsc.exe.config => app.config} | 4 + src/fsharp/IlxGen.fs | 9 +- src/fsharp/LexFilter.fs | 2 - src/fsharp/PrettyNaming.fs | 279 ++--- src/fsharp/ReferenceResolver.fs | 1 + src/fsharp/TastPickle.fs | 961 +++++++++-------- src/fsharp/TastPickle.fsi | 6 +- src/fsharp/ast.fs | 4 +- src/fsharp/fsc.fs | 10 +- src/fsharp/fsi/Fsi.fsproj | 4 +- src/fsharp/fsi/{fsi.exe.config => app.config} | 4 + src/fsharp/fsi/fsi.fs | 30 +- src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj | 5 +- .../app.config} | 4 + src/fsharp/lexhelp.fs | 24 +- src/fsharp/range.fs | 24 +- src/fsharp/symbols/Exprs.fsi | 1 + src/fsharp/symbols/SymbolHelpers.fs | 44 +- src/fsharp/symbols/SymbolHelpers.fsi | 8 +- src/fsharp/vs/IncrementalBuild.fs | 558 +++++----- src/fsharp/vs/IncrementalBuild.fsi | 7 +- src/fsharp/vs/Reactor.fs | 8 +- src/fsharp/vs/ServiceDeclarationLists.fs | 37 +- src/fsharp/vs/ServiceDeclarationLists.fsi | 17 + src/fsharp/vs/ServiceParamInfoLocations.fs | 72 +- src/fsharp/vs/ServiceParamInfoLocations.fsi | 19 +- src/fsharp/vs/ServiceUntypedParse.fs | 4 +- src/fsharp/vs/ServiceUntypedParse.fsi | 4 +- src/fsharp/vs/service.fs | 541 +++++----- src/fsharp/vs/service.fsi | 88 +- src/ilx/EraseClosures.fs | 516 +++++---- src/ilx/EraseUnions.fs | 6 +- src/update.cmd | 15 +- src/utils/reshapedreflection.fs | 10 +- tests/fsharp/core/attributes/test.fsx | 2 + .../printing/z.output.test.1000.stdout.bsl | 6 +- .../printing/z.output.test.200.stdout.bsl | 6 +- .../printing/z.output.test.default.stdout.bsl | 6 +- .../Source/CodeGen/EmittedIL/Misc/Int64.fs | 4 + .../CodeGen/EmittedIL/Misc/Int64.il.bsl | 134 +++ .../fsc/dumpAllCommandLineOptions/dummy.fs | 2 +- .../fsc/dumpAllCommandLineOptions/dummy.fsx | 2 +- .../Source/CompilerOptions/fsc/warn/env.lst | 11 +- .../Source/CompilerOptions/fsc/warn/warn40.fs | 5 + .../CompilerOptions/fsc/warnaserror/env.lst | 2 + .../Source/CompilerOptions/fsc/warnon/env.lst | 2 + .../src/HostedCompilerServer/App.config | 10 + ...mple_VS2012_FSharp_ConsoleApp_net45.fsproj | 79 +- ...mple_VS2012_FSharp_ConsoleApp_net45.fsproj | 11 +- tests/service/CSharpProjectAnalysis.fs | 2 +- tests/service/Common.fs | 4 +- tests/service/EditorTests.fs | 2 +- tests/service/ExprTests.fs | 2 +- tests/service/FileSystemTests.fs | 2 +- tests/service/FscTests.fs | 2 +- tests/service/FsiTests.fs | 2 +- tests/service/InteractiveCheckerTests.fs | 2 +- tests/service/MultiProjectAnalysisTests.fs | 68 +- tests/service/PerfTests.fs | 7 +- tests/service/ProjectAnalysisTests.fs | 72 +- tests/service/ProjectOptionsTests.fs | 28 +- tests/service/TokenizerTests.fs | 2 +- .../data/DifferingOutputDir/Dir1/Test1.fsproj | 2 +- .../data/DifferingOutputDir/Dir2/Test2.fsproj | 2 +- tests/service/data/FsAndFsiFiles.fsproj | 63 ++ .../ConsoleApplication1.fsproj | 2 +- .../ConsoleApplication2.fsproj | 2 +- tests/service/data/Space in name.fsproj | 2 +- tests/service/data/Test1.fsproj | 2 +- tests/service/data/Test2.fsproj | 2 +- .../data/TestProject/TestProject.fsproj | 2 +- tests/service/data/ToolsVersion12.fsproj | 2 +- .../TypeProviderConsole.fsproj | 2 +- .../TypeProviderLibrary.fsproj | 2 +- .../TestConsole/TestConsole.fsproj | 2 +- .../TypeProvidersBug/TypeProvidersBug.fsproj | 2 +- .../sqlite-net-spike/sqlite-net-spike.fsproj | 2 +- .../Utils/LanguageServiceProfiling/Program.fs | 3 +- .../Vsix/RegisterFsharpPackage.pkgdef | 2 +- .../Source.extension.vsixmanifest | 17 +- .../VisualFSharpFull/VisualFSharpFull.csproj | 117 --- .../Source.extension.vsixmanifest | 3 +- .../VisualFSharpOpenSource.csproj | 6 +- .../Source.extension.vsixmanifest | 39 + .../VisualFSharpTemplates.csproj | 218 ++++ .../fsharp-vsintegration-vsix-build.proj | 1 + .../ClassificationDefinitions.fs | 10 +- .../Classification/ColorizationService.fs | 4 +- ...eywordToDisposableConstructorInvocation.fs | 2 +- .../CodeFix/AddOpenCodeFixProvider.fs | 6 +- .../ImplementInterfaceCodeFixProvider.fs | 10 +- .../MissingReferenceCodeFixProvider.fs | 4 +- .../CodeFix/RemoveUnusedOpens.fs | 6 +- .../CodeFix/RenameUnusedValue.fs | 12 +- .../src/FSharp.Editor/CodeFix/SimplifyName.fs | 4 +- .../Commands/HelpContextService.fs | 4 +- .../Commands/XmlDocCommandService.fs | 4 +- .../Completion/CompletionProvider.fs | 10 +- .../FSharp.Editor/Completion/SignatureHelp.fs | 4 +- .../Debugging/BreakpointResolutionService.fs | 13 +- .../Diagnostics/DocumentDiagnosticAnalyzer.fs | 12 +- .../SimplifyNameDiagnosticAnalyzer.fs | 8 +- .../Diagnostics/UnusedDeclarationsAnalyzer.fs | 8 +- .../UnusedOpensDiagnosticAnalyzer.fs | 8 +- .../DocComments/XMLDocumentation.fs | 4 +- .../DocumentHighlightsService.fs | 6 +- .../FSharp.Editor/FSharp.Editor.Attributes.fs | 33 + .../src/FSharp.Editor/FSharp.Editor.fsproj | 7 +- .../Formatting/BraceMatchingService.fs | 8 +- .../Formatting/EditorFormattingService.fs | 8 +- .../Formatting/IndentationService.fs | 6 +- .../InlineRename/InlineRenameService.fs | 6 +- .../FSharpCheckerExtensions.fs | 8 +- .../LanguageService/LanguageService.fs | 51 +- .../LanguageService/SymbolHelpers.fs | 16 +- .../Navigation/FindUsagesService.fs | 10 +- .../Navigation/GoToDefinitionService.fs | 28 +- .../Navigation/NavigateToSearchService.fs | 16 +- .../Navigation/NavigationBarItemService.fs | 4 +- .../QuickInfo/QuickInfoProvider.fs | 12 +- .../Structure/BlockStructureService.fs | 4 +- .../src/FSharp.Editor/srFSharp.Editor.fs | 75 -- .../FSharp.LanguageService.Base.csproj | 2 +- .../BackgroundRequests.fs | 10 +- .../src/FSharp.LanguageService/Error.fs | 28 - .../FSharp.LanguageService.fsproj | 6 +- .../FSharp.LanguageService/FSharpSource.fs | 9 +- .../FSharp.LanguageService/GotoDefinition.fs | 16 +- .../ProjectSitesAndFiles.fs | 7 +- .../MSBuildUtilities.fs | 2 +- .../FSharp.ProjectSystem.FSharp/Project.fs | 40 +- .../ProjectPrelude.fs | 128 --- .../ProjectSystem.fsproj | 9 +- .../VSPackage.resx | 2 +- .../src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj | 6 +- .../FSharp.VS.FSI/FSharp.VS.FSI.Attributes.fs | 12 + .../src/FSharp.VS.FSI/fsiLanguageService.fs | 25 +- .../src/FSharp.VS.FSI/srProperties.fs | 52 - .../Salsa/FSharpLanguageServiceTestable.fs | 2 +- .../unittests/BraceMatchingServiceTests.fs | 11 +- .../unittests/BreakpointResolutionService.fs | 5 +- .../unittests/CompletionProviderTests.fs | 6 +- .../DocumentDiagnosticAnalyzerTests.fs | 12 +- .../DocumentHighlightsServiceTests.fs | 4 +- .../unittests/EditorFormattingServiceTests.fs | 14 +- .../unittests/IndentationServiceTests.fs | 102 +- .../tests/unittests/QuickInfoProviderTests.fs | 8 +- .../unittests/SignatureHelpProviderTests.fs | 4 +- .../Tests.LanguageService.Completion.fs | 6 +- .../VisualFSharp.Unittests.dll.config | 3 +- .../unittests/VisualFSharp.Unittests.fsproj | 2 +- vsintegration/update-vsintegration.cmd | 739 +++++++++++-- 284 files changed, 6180 insertions(+), 5459 deletions(-) create mode 100644 fcs/paket.lock delete mode 100755 mono/build-netcore.bat delete mode 100644 mono/build.bat delete mode 100644 mono/policy.2.0.FSharp.Core/Makefile delete mode 100644 mono/policy.2.0.FSharp.Core/policy.2.0.FSharp.Core.dll.config delete mode 100644 mono/policy.2.3.FSharp.Core/Makefile delete mode 100644 mono/policy.2.3.FSharp.Core/policy.2.3.FSharp.Core.dll.config delete mode 100644 mono/policy.3.259.FSharp.Core/Makefile delete mode 100644 mono/policy.3.259.FSharp.Core/policy.3.259.FSharp.Core.dll.config delete mode 100644 mono/policy.3.3.FSharp.Core/Makefile delete mode 100644 mono/policy.3.3.FSharp.Core/policy.3.3.FSharp.Core.dll.config delete mode 100644 mono/policy.3.47.FSharp.Core/Makefile delete mode 100644 mono/policy.3.47.FSharp.Core/policy.3.47.FSharp.Core.dll.config delete mode 100644 mono/policy.3.7.FSharp.Core/Makefile delete mode 100644 mono/policy.3.7.FSharp.Core/policy.3.7.FSharp.Core.dll.config delete mode 100644 mono/policy.3.78.FSharp.Core/Makefile delete mode 100644 mono/policy.3.78.FSharp.Core/policy.3.78.FSharp.Core.dll.config delete mode 100644 mono/policy.4.0.FSharp.Core/Makefile delete mode 100644 mono/policy.4.0.FSharp.Core/policy.4.0.FSharp.Core.dll.config delete mode 100644 mono/policy.4.3.FSharp.Core/Makefile delete mode 100644 mono/policy.4.3.FSharp.Core/policy.4.3.FSharp.Core.dll.config delete mode 100644 mono/policy.4.4.FSharp.Core/Makefile delete mode 100644 mono/policy.4.4.FSharp.Core/policy.4.4.FSharp.Core.dll.config rename src/{FSharpSource.BuildFromSource.targets => buildfromsource/BuildFromSource.targets} (89%) rename src/{fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj => buildfromsource/FSharp.Build/FSharp.Build.fsproj} (63%) rename src/{fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.BuildFromSource.fsproj => buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj} (70%) create mode 100644 src/buildfromsource/FSharp.Compiler.Private/.gitignore rename src/{fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.BuildFromSource.fsproj => buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj} (67%) rename src/{fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj => buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj} (87%) rename src/{fsharp/FSharp.Core/FSharp.Core.BuildFromSource.fsproj => buildfromsource/FSharp.Core/FSharp.Core.fsproj} (66%) rename src/{fsharp/Fsc/Fsc.BuildFromSource.fsproj => buildfromsource/Fsc/Fsc.fsproj} (75%) rename src/{fsharp/fsi/Fsi.BuildFromSource.fsproj => buildfromsource/Fsi/Fsi.fsproj} (76%) create mode 100644 src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs create mode 100644 src/fsharp/FSharp.Compiler.Private/.gitignore create mode 100644 src/fsharp/Fsc-proto/app.config delete mode 100644 src/fsharp/Fsc-proto/fsc-proto.exe.config rename src/fsharp/Fsc/{fsc.exe.config => app.config} (66%) rename src/fsharp/fsi/{fsi.exe.config => app.config} (64%) rename src/fsharp/{fsi/fsiAnyCpu.exe.config => fsiAnyCpu/app.config} (66%) create mode 100644 tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.fs create mode 100644 tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.il.bsl create mode 100644 tests/fsharpqa/Source/CompilerOptions/fsc/warn/warn40.fs create mode 100644 tests/service/data/FsAndFsiFiles.fsproj create mode 100644 vsintegration/Vsix/VisualFSharpTemplates/Source.extension.vsixmanifest create mode 100644 vsintegration/Vsix/VisualFSharpTemplates/VisualFSharpTemplates.csproj create mode 100644 vsintegration/src/FSharp.Editor/FSharp.Editor.Attributes.fs delete mode 100644 vsintegration/src/FSharp.Editor/srFSharp.Editor.fs create mode 100644 vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.Attributes.fs delete mode 100644 vsintegration/src/FSharp.VS.FSI/srProperties.fs diff --git a/.gitignore b/.gitignore index bbfad13703..133aa1231b 100644 --- a/.gitignore +++ b/.gitignore @@ -35,15 +35,6 @@ scripts/*.patch /src/fsharp/FSharp.Compiler.Private/*.sln /src/fsharp/FSharp.Compiler.Private/*.userprefs /src/*.log -/src/fsharp/FSharp.Compiler.Private/illex.fs -/src/fsharp/FSharp.Compiler.Private/ilpars.fs -/src/fsharp/FSharp.Compiler.Private/ilpars.fsi -/src/fsharp/FSharp.Compiler.Private/lex.fs -/src/fsharp/FSharp.Compiler.Private/pars.fs -/src/fsharp/FSharp.Compiler.Private/pars.fsi -/src/fsharp/FSharp.Compiler.Private/pplex.fs -/src/fsharp/FSharp.Compiler.Private/pppars.fs -/src/fsharp/FSharp.Compiler.Private/pppars.fsi /src/fsharp/Fsc-proto/illex.fs /src/fsharp/Fsc-proto/ilpars.fs /src/fsharp/Fsc-proto/ilpars.fsi diff --git a/DEVGUIDE.md b/DEVGUIDE.md index 5abd611460..d7f8318118 100644 --- a/DEVGUIDE.md +++ b/DEVGUIDE.md @@ -13,7 +13,15 @@ Follow the instructions below to build and develop the F# Compiler, Core Library Install - [.NET 4.5.1](http://www.microsoft.com/en-us/download/details.aspx?id=40779) -- [MSBuild 12.0](http://www.microsoft.com/en-us/download/details.aspx?id=40760) +- [MSBuild 12.0](http://www.microsoft.com/en-us/download/details.aspx?id=40760) or Visual Studio 2013 (or later) + +**NOTE on Windows:** +1. It is recommended to run the build.cmd and the qualifiers below on a command prompt with path set to have the location of MSBuild. If we have Visual Studio, we can also run using `Developer Command Prompt for Visual Studio 20xx` (depends on Visual Studio version). This developer command prompt is easier to use than normal command prompt, because it already has the correct path of Visual Studio and .NET's tooling set for us to use (including MSBuild). +2. The running command prompt must be run under Administrator right (`Run as Administrator`). + +Before running the build scripts, ensure that you have cleaned up the visualfsharp repo by running this git command: + + git clean -xfd On Windows you can build the F# compiler for .NET Framework as follows: diff --git a/FSharp.sln b/FSharp.sln index f4ac69591e..bfa07b6d43 100644 --- a/FSharp.sln +++ b/FSharp.sln @@ -205,18 +205,6 @@ Global {2E60864A-E3FF-4BCC-810F-DC7C34E6B236}.Release|Any CPU.Build.0 = Release|Any CPU {2E60864A-E3FF-4BCC-810F-DC7C34E6B236}.Release|x86.ActiveCfg = Release|Any CPU {2E60864A-E3FF-4BCC-810F-DC7C34E6B236}.Release|x86.Build.0 = Release|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Debug|Any CPU.Build.0 = Debug|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Debug|x86.ActiveCfg = Debug|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Debug|x86.Build.0 = Debug|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Proto|Any CPU.ActiveCfg = Proto|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Proto|Any CPU.Build.0 = Proto|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Proto|x86.ActiveCfg = Proto|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Proto|x86.Build.0 = Proto|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Release|Any CPU.ActiveCfg = Release|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Release|Any CPU.Build.0 = Release|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Release|x86.ActiveCfg = Release|Any CPU - {A437A6EC-5323-47C2-8F86-E2CAC54FF152}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -235,6 +223,5 @@ Global {88E2D422-6852-46E3-A740-83E391DC7973} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {4239EFEA-E746-446A-BF7A-51FCBAB13946} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {2E60864A-E3FF-4BCC-810F-DC7C34E6B236} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} - {A437A6EC-5323-47C2-8F86-E2CAC54FF152} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} EndGlobalSection EndGlobal diff --git a/Makefile b/Makefile index 7900fa869d..77a98f2871 100644 --- a/Makefile +++ b/Makefile @@ -14,51 +14,38 @@ all: $(MAKE) build build-proto: restore - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=Proto /p:TargetFramework=$(TargetFramework) src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=Proto /p:TargetFramework=$(TargetFramework) src/fsharp/Fsc-proto/Fsc-proto.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=Proto /p:TargetDotnetProfile=$(TargetDotnetProfile) src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=Proto /p:TargetDotnetProfile=$(TargetDotnetProfile) src/fsharp/Fsc-proto/Fsc-proto.fsproj # The main targets build: - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Core/FSharp.Core.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Build/FSharp.Build.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/Fsc/Fsc.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/fsi/Fsi.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 /p:FSharpCoreBackVersion=3.0 src/fsharp/FSharp.Core/FSharp.Core.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 /p:FSharpCoreBackVersion=3.1 src/fsharp/FSharp.Core/FSharp.Core.fsproj - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=net40 /p:FSharpCoreBackVersion=4.0 src/fsharp/FSharp.Core/FSharp.Core.fsproj - $(MAKE) -C mono/policy.2.0.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.2.3.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.3.3.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.3.7.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.3.47.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.3.78.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.3.259.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.4.0.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.4.3.FSharp.Core TargetFramework=net40 $@ - $(MAKE) -C mono/policy.4.4.FSharp.Core TargetFramework=net40 $@ -ifeq ("$(pclenabled47)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=portable47 src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif -ifeq ("$(pclenabled7)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=portable7 src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif -ifeq ("$(pclenabled78)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=portable78 src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif -ifeq ("$(pclenabled259)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=portable259 src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif -ifeq ("$(monodroidenabled)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=monoandroid10+monotouch10+xamarinios10 src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif -ifeq ("$(xamarinmacenabled)", "yes") - MONO_ENV_OPTIONS=$(monoopts) $(XBUILD) /p:Configuration=$(Configuration) /p:TargetFramework=xamarinmacmobile src/fsharp/FSharp.Core/FSharp.Core.fsproj -endif + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Core/FSharp.Core.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Build/FSharp.Build.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/Fsc/Fsc.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Compiler.Server.Shared/FSharp.Compiler.Server.Shared.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/fsi/Fsi.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj + MONO_ENV_OPTIONS=$(monoopts) $(MSBUILD) /p:Configuration=$(Configuration) /p:TargetDotnetProfile=net40 src/fsharp/FSharp.Core.Unittests/FSharp.Core.Unittests.fsproj + mkdir -p $(Configuration)/fsharp30/net40/bin + mkdir -p $(Configuration)/fsharp31/net40/bin + mkdir -p $(Configuration)/fsharp40/net40/bin + cp -p packages/FSharp.Core.3.0.2/lib/net40/* $(Configuration)/fsharp30/net40/bin + cp -p packages/FSharp.Core.3.1.2.5/lib/net40/* $(Configuration)/fsharp31/net40/bin + cp -p packages/FSharp.Core.4.0.0.1/lib/net40/* $(Configuration)/fsharp40/net40/bin + mkdir -p $(Configuration)/portable7/bin + cp -p packages/FSharp.Core.4.1.17/lib/portable-net45+netcore45/* $(Configuration)/portable7/bin + mkdir -p $(Configuration)/portable47/bin + cp -p packages/FSharp.Core.4.1.17/lib/portable-net45+sl5+netcore45/* $(Configuration)/portable47/bin + mkdir -p $(Configuration)/portable78/bin + cp -p packages/FSharp.Core.4.1.17/lib/portable-net45+netcore45+wp8/* $(Configuration)/portable78/bin + mkdir -p $(Configuration)/portable259/bin + cp -p packages/FSharp.Core.4.1.17/lib/portable-net45+netcore45+wpa81+wp8/* $(Configuration)/portable259/bin + mkdir -p $(Configuration)/monoandroid10+monotouch10+xamarinios10/bin + cp -p packages/FSharp.Core.4.1.17/lib/portable-net45+monoandroid10+monotouch10+xamarinios10/* $(Configuration)/monoandroid10+monotouch10+xamarinios10/bin + mkdir -p $(Configuration)/xamarinmacmobile/bin + cp -p packages/FSharp.Core.4.1.17/lib/xamarinmac20/* $(Configuration)/xamarinmacmobile/bin @@ -66,14 +53,12 @@ install: -rm -fr $(DESTDIR)$(monodir)/fsharp -rm -fr $(DESTDIR)$(monodir)/Microsoft\ F# -rm -fr $(DESTDIR)$(monodir)/Microsoft\ SDKs/F# - -rm -fr $(DESTDIR)$(monodir)/gac/FSharp.Core - -rm -fr $(DESTDIR)$(monodir)/gac/FSharp.Compiler.Private - -rm -fr $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v/FSharp - -rm -fr $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v11.0/FSharp - -rm -fr $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v12.0/FSharp - -rm -fr $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v14.0/FSharp - -rm -fr $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v15.0/FSharp - $(MAKE) -C mono/FSharp.Core TargetFramework=net40 install + -rm -fr $(DESTDIR)$(monodir)/msbuild/Microsoft/VisualStudio/v/FSharp + -rm -fr $(DESTDIR)$(monodir)/msbuild/Microsoft/VisualStudio/v11.0/FSharp + -rm -fr $(DESTDIR)$(monodir)/msbuild/Microsoft/VisualStudio/v12.0/FSharp + -rm -fr $(DESTDIR)$(monodir)/msbuild/Microsoft/VisualStudio/v14.0/FSharp + -rm -fr $(DESTDIR)$(monodir)/msbuild/Microsoft/VisualStudio/v15.0/FSharp + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=net40 install $(MAKE) -C mono/FSharp.Build install $(MAKE) -C mono/FSharp.Compiler.Private install $(MAKE) -C mono/Fsc install @@ -81,39 +66,17 @@ install: $(MAKE) -C mono/FSharp.Compiler.Server.Shared install $(MAKE) -C mono/fsi install $(MAKE) -C mono/fsiAnyCpu install - $(MAKE) -C mono/FSharp.Core TargetFramework=net40 FSharpCoreBackVersion=3.0 install - $(MAKE) -C mono/FSharp.Core TargetFramework=net40 FSharpCoreBackVersion=3.1 install - $(MAKE) -C mono/FSharp.Core TargetFramework=net40 FSharpCoreBackVersion=4.0 install - $(MAKE) -C mono/policy.2.0.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.2.3.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.3.3.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.3.7.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.3.47.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.3.78.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.3.259.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.4.0.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.4.3.FSharp.Core TargetFramework=net40 install - $(MAKE) -C mono/policy.4.4.FSharp.Core TargetFramework=net40 install -ifeq ("$(pclenabled47)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=portable47 install -endif -ifeq ("$(pclenabled7)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=portable7 install -endif -ifeq ("$(pclenabled78)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=portable78 install -endif -ifeq ("$(pclenabled259)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=portable259 install -endif -ifeq ("$(monodroidenabled)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=monoandroid10+monotouch10+xamarinios10 install -endif -ifeq ("$(xamarinmacenabled)", "yes") - $(MAKE) -C mono/FSharp.Core TargetFramework=xamarinmacmobile install -endif + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=net40 FSharpCoreBackVersion=3.0 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=net40 FSharpCoreBackVersion=3.1 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=net40 FSharpCoreBackVersion=4.0 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=portable47 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=portable7 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=portable78 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=portable259 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=monoandroid10+monotouch10+xamarinios10 install + $(MAKE) -C mono/FSharp.Core TargetDotnetProfile=xamarinmacmobile install echo "------------------------------ INSTALLED FILES --------------" - ls -xlR $(DESTDIR)$(monodir)/fsharp $(DESTDIR)$(monodir)/xbuild $(DESTDIR)$(monodir)/gac/FSharp* $(DESTDIR)$(monodir)/Microsoft* + ls -xlR $(DESTDIR)$(monodir)/fsharp $(DESTDIR)$(monodir)/msbuild $(DESTDIR)$(monodir)/xbuild $(DESTDIR)$(monodir)/Reference\ Assemblies $(DESTDIR)$(monodir)/gac/FSharp* $(DESTDIR)$(monodir)/Microsoft* || true dist: -rm -r fsharp-$(DISTVERSION) fsharp-$(DISTVERSION).tar.bz2 diff --git a/before_install.sh b/before_install.sh index db4e9cbf67..d1498a55e6 100755 --- a/before_install.sh +++ b/before_install.sh @@ -58,7 +58,7 @@ fi) fi) #TODO: work out how to avoid the need for this -chmod u+x packages/FSharp.Compiler.Tools.4.1.23/tools/fsi.exe +chmod u+x packages/FSharp.Compiler.Tools.4.1.27/tools/fsi.exe chmod u+x packages/FsLexYacc.7.0.6/build/fslex.exe chmod u+x packages/FsLexYacc.7.0.6/build/fsyacc.exe diff --git a/build.cmd b/build.cmd index e03f908671..5624de77d8 100644 --- a/build.cmd +++ b/build.cmd @@ -60,7 +60,7 @@ set BUILD_PHASE=1 set BUILD_NET40=0 set BUILD_NET40_FSHARP_CORE=0 set BUILD_CORECLR=0 -set BUILD_BUILDFROMSOURCE=0 +set BUILD_FROMSOURCE=0 set BUILD_VS=0 set BUILD_FCS=0 set BUILD_CONFIG=release @@ -396,7 +396,7 @@ echo BUILD_PROTO_WITH_CORECLR_LKG=%BUILD_PROTO_WITH_CORECLR_LKG% echo BUILD_NET40=%BUILD_NET40% echo BUILD_NET40_FSHARP_CORE=%BUILD_NET40_FSHARP_CORE% echo BUILD_CORECLR=%BUILD_CORECLR% -echo BUILD_BUILDFROMSOURCE=%BUILD_BUILDFROMSOURCE% +echo BUILD_FROMSOURCE=%BUILD_FROMSOURCE% echo BUILD_VS=%BUILD_VS% echo BUILD_FCS=%BUILD_FCS% echo BUILD_SETUP=%BUILD_SETUP% @@ -417,11 +417,12 @@ echo PUBLISH_VSIX=%PUBLISH_VSIX% echo MYGET_APIKEY=%MYGET_APIKEY% echo TEMP=%TEMP% -REM load Visual Studio 2017 developer command prompt if VS150COMNTOOLS is not set +:: load Visual Studio 2017 developer command prompt if VS150COMNTOOLS is not set -REM If this is not set, VsDevCmd.bat will change %cd% to [USERPROFILE]\source, causing the build to fail. +:: If this is not set, VsDevCmd.bat will change %cd% to [USERPROFILE]\source, causing the build to fail. SET VSCMD_START_DIR=%cd% +:: try to find an RC or RTM edition of VS2017 if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Enterprise\Common7\Tools\VsDevCmd.bat" ( call "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Enterprise\Common7\Tools\VsDevCmd.bat" ) @@ -431,15 +432,28 @@ if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Stud if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat" ( call "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat" ) + +:: Allow build from Preview editions +if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Enterprise\Common7\Tools\VsDevCmd.bat" ( + call "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Enterprise\Common7\Tools\VsDevCmd.bat" +) +if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Professional\Common7\Tools\VsDevCmd.bat" ( + call "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Enterprise\Common7\Tools\VsDevCmd.bat" +) +if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Community\Common7\Tools\VsDevCmd.bat" ( + call "%ProgramFiles(x86)%\Microsoft Visual Studio\Preview\Enterprise\Common7\Tools\VsDevCmd.bat" +) + +:: If there's no installation of VS2017 or VS2017 Preview, use the build tools if "%VS150COMNTOOLS%" EQU "" if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\Common7\Tools\VsDevCmd.bat" ( call "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\Common7\Tools\VsDevCmd.bat" ) -echo . +echo. echo Environment set -echo . -echo . +echo. +echo. echo ---------------- Done with arguments, starting preparation ----------------- @@ -554,7 +568,7 @@ set _dotnet20exe=%~dp0Tools\dotnet20\dotnet.exe set NUGET_PACKAGES=%~dp0Packages set path=%~dp0Tools\dotnet20\;%path% -set _fsiexe="packages\FSharp.Compiler.Tools.4.1.23\tools\fsi.exe" +set _fsiexe="packages\FSharp.Compiler.Tools.4.1.27\tools\fsi.exe" if not exist %_fsiexe% echo Error: Could not find %_fsiexe% && goto :failure %_ngenexe% install %_fsiexe% /nologo @@ -592,8 +606,8 @@ if "%BUILD_PROTO%" == "1" ( if "%BUILD_PROTO_WITH_CORECLR_LKG%" == "0" ( - echo %_ngenexe% install packages\FSharp.Compiler.Tools.4.1.23\tools\fsc.exe /nologo - %_ngenexe% install packages\FSharp.Compiler.Tools.4.1.23\tools\fsc.exe /nologo + echo %_ngenexe% install packages\FSharp.Compiler.Tools.4.1.27\tools\fsc.exe /nologo + %_ngenexe% install packages\FSharp.Compiler.Tools.4.1.27\tools\fsc.exe /nologo echo %_msbuildexe% %msbuildflags% src\fsharp-proto-build.proj /p:BUILD_PROTO_WITH_CORECLR_LKG=%BUILD_PROTO_WITH_CORECLR_LKG% /p:Configuration=Proto %_msbuildexe% %msbuildflags% src\fsharp-proto-build.proj /p:BUILD_PROTO_WITH_CORECLR_LKG=%BUILD_PROTO_WITH_CORECLR_LKG% /p:Configuration=Proto @@ -639,15 +653,17 @@ if "%OSARCH%"=="AMD64" set SYSWOW64=SysWoW64 if not "%OSARCH%"=="x86" set REGEXE32BIT=%WINDIR%\syswow64\reg.exe -echo SDK environment vars from Registry (note: ignore "ERROR: The system was unable to find ....") +echo SDK environment vars from Registry echo ================================== - FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B + +::See https://stackoverflow.com/a/17113667/111575 on 2^>NUL for suppressing the error "ERROR: The system was unable to find the specified registry key or value." from reg.exe, this fixes #3619 + FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B set PATH=%PATH%;%WINSDKNETFXTOOLS% for /d %%i in (%WINDIR%\Microsoft.NET\Framework\v4.0.?????) do set CORDIR=%%i @@ -659,7 +675,7 @@ IF NOT DEFINED SNEXE32 IF EXIST "%WINSDKNETFXTOOLS%\sn.exe" set IF NOT DEFINED SNEXE64 IF EXIST "%WINSDKNETFXTOOLS%x64\sn.exe" set SNEXE64=%WINSDKNETFXTOOLS%x64\sn.exe IF NOT DEFINED ildasm IF EXIST "%WINSDKNETFXTOOLS%\ildasm.exe" set ildasm=%WINSDKNETFXTOOLS%ildasm.exe -echo . +echo. echo SDK environment vars echo ======================= echo WINSDKNETFXTOOLS: %WINSDKNETFXTOOLS% diff --git a/configure.ac b/configure.ac index e8370aa7b7..ec3df2198f 100644 --- a/configure.ac +++ b/configure.ac @@ -46,93 +46,17 @@ MONOPREFIX=$(cd `$PKG_CONFIG --variable=prefix mono` && pwd) MONOBINDIR="$MONOPREFIX"/bin MONOLIBDIR="$MONOPREFIX"/lib -AC_PATH_PROG(XBUILD, xbuild, no) -xbuild_from_pkg_config="$MONOBINDIR"/xbuild -if test -e $xbuild_from_pkg_config; then - XBUILD=$xbuild_from_pkg_config -elif test "x$XBUILD" == "xno"; then - AC_MSG_ERROR([Could not find xbuild]) +AC_PATH_PROG(MSBUILD, msbuild, no) +msbuild_from_pkg_config="$MONOBINDIR"/msbuild +if test -e $msbuild_from_pkg_config; then + MSBUILD=$msbuild_from_pkg_config +elif test "x$MSBUILD" == "xno"; then + AC_MSG_ERROR([Could not find msbuild]) fi -AC_MSG_NOTICE(xbuild: $XBUILD) - -MONOGACDIR="$MONOLIBDIR"/mono -if ! test "x$with_gacdir" = "xno"; then - MONOGACDIR=$(cd "$with_gacdir/.." && pwd) -fi - -MONOGACDIR40="$MONOGACDIR"/4.0 -MONOGACDIR45="$MONOGACDIR"/4.5 - -if ! test -e $MONOGACDIR45/mscorlib.dll; then - AC_ERROR(Couldn't find the mono gac directory or mscorlib.dll in the usual places. Set --with-gacdir=) -fi - -if test -e $MONOLIBDIR/mono/xbuild-frameworks/.NETPortable/v4.0/Profile/Profile47/mscorlib.dll; then - PCLENABLED47=yes -else - PCLENABLED47=no -fi -AC_MSG_NOTICE(PCL Reference Assemblies for Profile 47 found: $PCLENABLED47) - -AC_SUBST(PCLENABLED47) - - -if test -e $MONOLIBDIR/mono/xbuild-frameworks/.NETPortable/v4.0/Profile/Profile47/mscorlib.dll; then - PCLENABLED47=yes -else - PCLENABLED47=no -fi -AC_MSG_NOTICE(PCL Reference Assemblies for Profile 47 found: $PCLENABLED47) - -AC_SUBST(PCLENABLED47) - - -if test -e $MONOLIBDIR/mono/xbuild-frameworks/.NETPortable/v4.5/Profile/Profile7/System.Runtime.dll; then - PCLENABLED7=yes -else - PCLENABLED7=no -fi -AC_MSG_NOTICE(PCL Reference Assemblies for Profile 7 found: $PCLENABLED7) - -AC_SUBST(PCLENABLED7) - -if test -e $MONOLIBDIR/mono/xbuild-frameworks/.NETPortable/v4.5/Profile/Profile78/System.Runtime.dll; then - PCLENABLED78=yes -else - PCLENABLED78=no -fi -AC_MSG_NOTICE(PCL Reference Assemblies for Profile 78 found: $PCLENABLED78) - -AC_SUBST(PCLENABLED78) - -if test -e $MONOLIBDIR/mono/xbuild-frameworks/.NETPortable/v4.5/Profile/Profile259/System.Runtime.dll; then - PCLENABLED259=yes -else - PCLENABLED259=no -fi -AC_MSG_NOTICE(PCL Reference Assemblies for Profile 259 found: $PCLENABLED259) - -AC_SUBST(PCLENABLED259) - -# We enable MonoTouch and MonoDroid builds if PCL components are available. -# These build using binaries from dependencies/mono/2.1, but see -# https://github.com/fsharp/fsharp/issues/391 where PCL is a requirement of -# Microsoft.Common.targets when used in this configuration -MONOTOUCHENABLED=$PCLENABLED78 -MONODROIDENABLED=$PCLENABLED78 -XAMARINMACENABLED=$PCLENABLED78 - -AC_SUBST(MONOTOUCHENABLED) -AC_SUBST(MONODROIDENABLED) -AC_SUBST(XAMARINMACENABLED) +AC_MSG_NOTICE(msbuild: $MSBUILD) AC_SUBST(MONOBINDIR) AC_SUBST(MONOLIBDIR) -AC_SUBST(MONOGACDIR) - -AC_SUBST(MONOGACDIR20) -AC_SUBST(MONOGACDIR35) -AC_SUBST(MONOGACDIR40) AC_CONFIG_FILES([ mono/launcher diff --git a/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj b/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj index deef4f0e68..e929138c56 100644 --- a/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj +++ b/fcs/FSharp.Compiler.Service.MSBuild.v12/FSharp.Compiler.Service.MSBuild.v12.fsproj @@ -88,5 +88,5 @@ True - + \ No newline at end of file diff --git a/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj b/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj index 07625e300e..b75f912c98 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj +++ b/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj @@ -63,5 +63,5 @@ True - + \ No newline at end of file diff --git a/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs b/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs index 462c749f2d..45fab18685 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs +++ b/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs @@ -16,11 +16,17 @@ type ProjectCracker = let enableLogging = defaultArg enableLogging true let logMap = ref Map.empty - let rec convert (opts: Microsoft.FSharp.Compiler.SourceCodeServices.ProjectCrackerTool.ProjectOptions) : FSharpProjectOptions = + let rec convert (opts: ProjectCrackerTool.ProjectOptions) : FSharpProjectOptions = + if not (isNull opts.Error) then failwith opts.Error + let referencedProjects = Array.map (fun (a, b) -> a, convert b) opts.ReferencedProjectOptions let sourceFiles, otherOptions = - opts.Options |> Array.partition (fun x -> x.IndexOfAny(Path.GetInvalidPathChars()) = -1 && Path.GetExtension(x).ToLower() = ".fs") + opts.Options + |> Array.partition (fun x -> + let extension = Path.GetExtension(x).ToLower() + x.IndexOfAny(Path.GetInvalidPathChars()) = -1 + && (extension = ".fs" || extension = ".fsi")) let sepChar = Path.DirectorySeparatorChar @@ -73,8 +79,8 @@ type ProjectCracker = p.StartInfo.RedirectStandardOutput <- true ignore <| p.Start() - let ser = new System.Runtime.Serialization.Json.DataContractJsonSerializer(typeof) - let opts = ser.ReadObject(p.StandardOutput.BaseStream) :?> Microsoft.FSharp.Compiler.SourceCodeServices.ProjectCrackerTool.ProjectOptions + let ser = new DataContractJsonSerializer(typeof) + let opts = ser.ReadObject(p.StandardOutput.BaseStream) :?> ProjectCrackerTool.ProjectOptions #endif convert opts, !logMap diff --git a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj index bb29e5b736..07bae7e576 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj +++ b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/FSharp.Compiler.Service.ProjectCrackerTool.fsproj @@ -79,5 +79,5 @@ - + \ No newline at end of file diff --git a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerOptions.fs b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerOptions.fs index 34f3aa16e7..71cb966fb1 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerOptions.fs +++ b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerOptions.fs @@ -7,4 +7,5 @@ type ProjectOptions = Options: string[] ReferencedProjectOptions: (string * ProjectOptions)[] LogOutput: string + Error: string } diff --git a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerTool.fs b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerTool.fs index 639d4d0c2b..9be9c37537 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerTool.fs +++ b/fcs/FSharp.Compiler.Service.ProjectCrackerTool/ProjectCrackerTool.fs @@ -420,7 +420,8 @@ module internal ProjectCrackerTool = let options = { ProjectFile = file Options = Array.ofSeq (parsedProject.Options @ referencedProjectOutputs) ReferencedProjectOptions = referencedProjectOptions - LogOutput = parsedProject.LogOutput } + LogOutput = parsedProject.LogOutput + Error = null } parsedProject.OutputFile, options @@ -465,9 +466,11 @@ module internal ProjectCrackerTool = 2, { ProjectFile = projectFile; Options = [||]; ReferencedProjectOptions = [||]; - LogOutput = e.ToString() } + LogOutput = e.ToString() + Error = e.Message } else 1, { ProjectFile = ""; Options = [||]; ReferencedProjectOptions = [||]; - LogOutput = "At least two arguments required." } + LogOutput = "At least two arguments required." + Error = null } diff --git a/fcs/FSharp.Compiler.Service.Tests/App.config b/fcs/FSharp.Compiler.Service.Tests/App.config index 76cc57718b..1e7989fe8c 100644 --- a/fcs/FSharp.Compiler.Service.Tests/App.config +++ b/fcs/FSharp.Compiler.Service.Tests/App.config @@ -7,6 +7,10 @@ + + + + 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 95498ca69c..98e86a0644 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -71,11 +71,11 @@ ProjectOptionsTests.fs - + FSharp.Core.optdata PreserveNewest - + FSharp.Core.sigdata PreserveNewest @@ -100,7 +100,7 @@ - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True @@ -109,7 +109,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -129,5 +129,5 @@ True - + \ No newline at end of file diff --git a/fcs/FSharp.Compiler.Service.sln b/fcs/FSharp.Compiler.Service.sln index e1be709379..2fe403a3e3 100644 --- a/fcs/FSharp.Compiler.Service.sln +++ b/fcs/FSharp.Compiler.Service.sln @@ -1,13 +1,15 @@ Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 -VisualStudioVersion = 15.0.26730.8 +VisualStudioVersion = 15.0.26730.16 MinimumVisualStudioVersion = 10.0.40219.1 Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "project", "project", "{B6B68AE6-E7A4-4D43-9B34-FFA74BFE192B}" ProjectSection(SolutionItems) = preProject build.cmd = build.cmd build.fsx = build.fsx build.sh = build.sh + nuget\FSharp.Compiler.Service.MSBuild.v12.nuspec = nuget\FSharp.Compiler.Service.MSBuild.v12.nuspec nuget\FSharp.Compiler.Service.nuspec = nuget\FSharp.Compiler.Service.nuspec + nuget\FSharp.Compiler.Service.ProjectCracker.nuspec = nuget\FSharp.Compiler.Service.ProjectCracker.nuspec paket.dependencies = paket.dependencies README.md = README.md RELEASE_NOTES.md = RELEASE_NOTES.md diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 99611113df..07d9840cde 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -626,7 +626,7 @@ $(FSharpSourcesRoot)\..\packages\System.Reflection.Metadata.1.4.2\lib\portable-net45+win8\System.Reflection.Metadata.dll - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.3.1\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll $(FSharpSourcesRoot)\..\packages\System.ValueTuple.4.3.1\lib\netstandard1.0\System.ValueTuple.dll @@ -639,7 +639,7 @@ - + \ No newline at end of file diff --git a/fcs/README.md b/fcs/README.md index cb2d32dbf8..3e21f6322a 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\FSharp.Compiler.Service.14.0.2.nupkg %APIKEY% -Source https://nuget.org - .nuget\nuget.exe push Release\FSharp.Compiler.Service.MSBuild.v12.14.0.2.nupkg %APIKEY% -Source https://nuget.org - .nuget\nuget.exe push Release\FSharp.Compiler.Service.ProjectCracker.14.0.2.nupkg %APIKEY% -Source https://nuget.org + .nuget\nuget.exe push Release\FSharp.Compiler.Service.16.0.2.nupkg %APIKEY% -Source https://nuget.org + .nuget\nuget.exe push Release\FSharp.Compiler.Service.MSBuild.v12.16.0.2.nupkg %APIKEY% -Source https://nuget.org + .nuget\nuget.exe push Release\FSharp.Compiler.Service.ProjectCracker.16.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 18f26ff87e..dd33909ca8 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,4 +1,15 @@ -#### 14.0.2 +#### 16.0.2 + * [ProjectCracker returns *.fsi files in FSharpProjectOptions.SourceFiles array](https://github.com/fsharp/FSharp.Compiler.Service/pull/812) + + * [Fix line endings in the Nuget packages descriptions](https://github.com/fsharp/FSharp.Compiler.Service/pull/811) + +#### 16.0.1 + * FSharpChecker provides non-reactor ParseFile instead of ParseFileInProject + * Add FSharpParsingOptions, GetParsingOptionsFromProjectOptions, GetParsingOptionsFromCommandLine + +#### 15.0.1 + * Integrate latest changes from visualfsharp + * Add implementation file contents to CheckFileResults * Fix non-public API in .NET Standard 1.6 version #### 14.0.1 diff --git a/fcs/build.fsx b/fcs/build.fsx index 7e2e12f1be..d3c850757e 100644 --- a/fcs/build.fsx +++ b/fcs/build.fsx @@ -99,9 +99,9 @@ Target "Test.NetFx" (fun _ -> // -------------------------------------------------------------------------------------- // Build a NuGet package Target "NuGet.NetFx" (fun _ -> - runCmdIn __SOURCE_DIRECTORY__ @"..\.nuget\NuGet.exe" @"pack nuget\FSharp.Compiler.Service.nuspec -OutputDirectory %s" releaseDir - runCmdIn __SOURCE_DIRECTORY__ @"..\.nuget\NuGet.exe" @"pack nuget\FSharp.Compiler.Service.MSBuild.v12.nuspec -OutputDirectory %s" releaseDir - runCmdIn __SOURCE_DIRECTORY__ @"..\.nuget\NuGet.exe" @"pack nuget\FSharp.Compiler.Service.ProjectCracker.nuspec -OutputDirectory %s" releaseDir + runCmdIn __SOURCE_DIRECTORY__ "../.nuget/NuGet.exe" @"pack nuget/FSharp.Compiler.Service.nuspec -OutputDirectory %s" releaseDir + runCmdIn __SOURCE_DIRECTORY__ "../.nuget/NuGet.exe" @"pack nuget/FSharp.Compiler.Service.MSBuild.v12.nuspec -OutputDirectory %s" releaseDir + runCmdIn __SOURCE_DIRECTORY__ "../.nuget/NuGet.exe" @"pack nuget/FSharp.Compiler.Service.ProjectCracker.nuspec -OutputDirectory %s" releaseDir ) @@ -144,11 +144,11 @@ Target "Nuget.AddNetStd" (fun _ -> // Generate the documentation Target "GenerateDocsEn" (fun _ -> - executeFSIWithArgs "docsrc/tools" "generate.fsx" ["--define:RELEASE"] [] |> ignore + executeFSIWithArgs "docsrc/tools" "generate.fsx" [] [] |> ignore ) Target "GenerateDocsJa" (fun _ -> - executeFSIWithArgs "docsrc/tools" "generate.ja.fsx" ["--define:RELEASE"] [] |> ignore + executeFSIWithArgs "docsrc/tools" "generate.ja.fsx" [] [] |> ignore ) // -------------------------------------------------------------------------------------- diff --git a/fcs/docsrc/content/caches.fsx b/fcs/docsrc/content/caches.fsx index cfed3248ec..e63857c5da 100644 --- a/fcs/docsrc/content/caches.fsx +++ b/fcs/docsrc/content/caches.fsx @@ -21,19 +21,14 @@ Each FSharpChecker object maintains a set of caches. These are * ``braceMatchCache`` - an MRU cache of size ``braceMatchCacheSize`` (default = 5) keeping the results of calls to MatchBraces, keyed by filename, source and project options. -* ``parseFileInProjectCache`` - an MRU cache of size ``parseFileInProjectCacheSize`` (default = 2) keeping the results of ParseFileInProject, +* ``parseFileCache`` - an MRU cache of size ``parseFileCacheSize`` (default = 2) keeping the results of ParseFile, keyed by filename, source and project options. -* ``parseAndCheckFileInProjectCache`` - an MRU cache of size ``incrementalTypeCheckCacheSize`` (default = 5) keeping the results of +* ``checkFileInProjectCache`` - an MRU cache of size ``incrementalTypeCheckCacheSize`` (default = 5) keeping the results of ParseAndCheckFileInProject, CheckFileInProject and/or CheckFileInProjectIfReady. This is keyed by filename, file source and project options. The results held in this cache are only returned if they would reflect an accurate parse and check of the file. -* ``parseAndCheckFileInProjectCachePossiblyStale`` - a somewhat peculiar MRU cache of size ``incrementalTypeCheckCacheSize`` (default = 5) - keeping the results of ParseAndCheckFileInProject, CheckFileInProject and CheckFileInProjectIfReady, - keyed by filename and project options. This cache is accessed by TryGetRecentTypeCheckResultsForFile. Because the results - are accessed regardless of the content of the file, the checking results returned may be "stale". - * ``getToolTipTextCache`` - an aged lookup cache of strong size ``getToolTipTextSize`` (default = 5) computing the results of GetToolTipText. * ``ilModuleReaderCache`` - an aged lookup of weak references to "readers" for references .NET binaries. Because these diff --git a/fcs/docsrc/content/corelib.fsx b/fcs/docsrc/content/corelib.fsx index 6ec522f316..e7959385f8 100644 --- a/fcs/docsrc/content/corelib.fsx +++ b/fcs/docsrc/content/corelib.fsx @@ -19,19 +19,25 @@ an FSharp.Core.optdata and FSharp.Core.sigdata, see below for guidance. Binding redirects for your application -------------------------------------- -The FSharp.Compiler.Service.dll component depends on FSharp.Core 4.3.0.0. Normally your application will target +The FSharp.Compiler.Service.dll component depends on FSharp.Core 4.4.0.0. Normally your application will target a later version of FSharp.Core, and you will need a [binding redirect](http://msdn.microsoft.com/en-us/library/7wd6ex19(v=vs.110).aspx) to ensure -that FSharp.Core 4.3.0.0 forwards to which the final version of FSharp.Core.dll your application uses. +that other versions of FSharp.Core forward to the final version of FSharp.Core.dll your application uses. Binding redirect files are normally generated automatically by build tools. If not, you can use one like this (if your tool is called ``HostedCompiler.exe``, the binding redirect file is called ``HostedCompiler.exe.config``) +Some other dependencies may also need to be reconciled and forwarded. + - + + + + + diff --git a/fcs/docsrc/content/editor.fsx b/fcs/docsrc/content/editor.fsx index ccd61e922d..d6b19fd0e6 100644 --- a/fcs/docsrc/content/editor.fsx +++ b/fcs/docsrc/content/editor.fsx @@ -56,16 +56,19 @@ let projOptions = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously +let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(projOptions) + (** To perform type checking, we first need to parse the input using -`ParseFileInProject`, which gives us access to the [untyped AST](untypedtree.html). However, +`ParseFile`, which gives us access to the [untyped AST](untypedtree.html). However, then we need to call `CheckFileInProject` to perform the full type checking. This function also requires the result of `ParseFileInProject`, so the two functions are often called together. *) // Perform parsing + let parseFileResults = - checker.ParseFileInProject(file, input, projOptions) + checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously (** Before we look at the interesting operations provided by `TypeCheckResults`, we diff --git a/fcs/docsrc/content/ja/corelib.fsx b/fcs/docsrc/content/ja/corelib.fsx index 40d3dbcd51..e2189faaea 100644 --- a/fcs/docsrc/content/ja/corelib.fsx +++ b/fcs/docsrc/content/ja/corelib.fsx @@ -26,6 +26,10 @@ FSharp.Compiler.Service.dll コンポーネントは FSharp.Core 4.3.0.0 に依 + + + + diff --git a/fcs/docsrc/content/ja/editor.fsx b/fcs/docsrc/content/ja/editor.fsx index 9e4ac05b3c..014be2e86c 100644 --- a/fcs/docsrc/content/ja/editor.fsx +++ b/fcs/docsrc/content/ja/editor.fsx @@ -58,20 +58,22 @@ let file = "/home/user/Test.fsx" let projOptions = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously +let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(projOptions) + (** -型チェックを実行するには、まず `ParseFileInProject` を使って +型チェックを実行するには、まず `ParseFile` を使って 入力値をパースする必要があります。 このメソッドを使うと [型無しAST](untypedtree.html) にアクセスできるようになります。 しかし今回は完全な型チェックを実行するため、続けて `CheckFileInProject` を呼び出す必要があります。 -このメソッドは `ParseFileInProject` の結果も必要とするため、 +このメソッドは `ParseFile` の結果も必要とするため、 たいていの場合にはこれら2つのメソッドをセットで呼び出すことになります。 *) // パースを実行 let parseFileResults = - checker.ParseFileInProject(file, input, projOptions) + checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously (** `TypeCheckResults` に備えられた興味深い機能の紹介に入る前に、 diff --git a/fcs/docsrc/content/ja/untypedtree.fsx b/fcs/docsrc/content/ja/untypedtree.fsx index f34f9c6b43..df6b6f4deb 100644 --- a/fcs/docsrc/content/ja/untypedtree.fsx +++ b/fcs/docsrc/content/ja/untypedtree.fsx @@ -73,9 +73,11 @@ let getUntypedTree (file, input) = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously + let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(projOptions) + // コンパイラの第1フェーズを実行する let untypedRes = - checker.ParseFileInProject(file, input, projectOptions) + checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously match untypedRes.ParseTree with diff --git a/fcs/docsrc/content/untypedtree.fsx b/fcs/docsrc/content/untypedtree.fsx index 600e87fb04..d67a1ef71b 100644 --- a/fcs/docsrc/content/untypedtree.fsx +++ b/fcs/docsrc/content/untypedtree.fsx @@ -49,7 +49,7 @@ To get the AST, we define a function that takes file name and the source code (the file is only used for location information and does not have to exist). We first need to get "interactive checker options" which represents the context. For simple tasks, you can use `GetProjectOptionsFromScriptRoot` which infers -the context for a script file. Then we use the `ParseFileInProject` method and +the context for a script file. Then we use the `ParseFile` method and return the `ParseTree` property: *) @@ -60,9 +60,11 @@ let getUntypedTree (file, input) = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously + let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(projOptions) + // Run the first phase (untyped parsing) of the compiler let parseFileResults = - checker.ParseFileInProject(file, input, projOptions) + checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously match parseFileResults.ParseTree with diff --git a/fcs/docsrc/tools/generate.fsx b/fcs/docsrc/tools/generate.fsx index b00ee47862..59bd10187a 100644 --- a/fcs/docsrc/tools/generate.fsx +++ b/fcs/docsrc/tools/generate.fsx @@ -42,7 +42,8 @@ let docTemplate = formatting @@ "templates/docpage.cshtml" // Where to look for *.csproj templates (in this order) let layoutRoots = - [ templates; formatting @@ "templates" + [ templates; + formatting @@ "templates" formatting @@ "templates/reference" ] // Copy static files and CSS + JS from F# Formatting @@ -84,12 +85,11 @@ let buildReference () = // Build documentation from `fsx` and `md` files in `docsrc/content` let buildDocumentation () = - let subdirs = Directory.EnumerateDirectories(content, "*", SearchOption.AllDirectories) - for dir in Seq.append [content] subdirs do + for dir in [content] do let sub = if dir.Length > content.Length then dir.Substring(content.Length + 1) else "." Literate.ProcessDirectory ( dir, docTemplate, output @@ sub, replacements = ("root", root)::info, - layoutRoots = layoutRoots, generateAnchors = true ) + layoutRoots = layoutRoots, generateAnchors = true, processRecursive=false ) // Generate copyFiles() diff --git a/fcs/docsrc/tools/generate.ja.fsx b/fcs/docsrc/tools/generate.ja.fsx index b7e9b25d00..8044db885d 100644 --- a/fcs/docsrc/tools/generate.ja.fsx +++ b/fcs/docsrc/tools/generate.ja.fsx @@ -38,11 +38,7 @@ open FSharp.MetadataFormat // When called from 'build.fsx', use the public project URL as // otherwise, use the current 'output' directory. -#if RELEASE -let root = website -#else -let root = "file://" + (__SOURCE_DIRECTORY__ @@ "../output/ja") -#endif +let root = "." // Paths with template/source/output locations let bin = __SOURCE_DIRECTORY__ @@ "../../../Release/fcs/net45" @@ -56,15 +52,15 @@ let docTemplate = formatting @@ "templates/docpage.cshtml" // Where to look for *.csproj templates (in this order) let layoutRoots = [ templates - formatting @@ "templates"] + formatting @@ "templates" + formatting @@ "templates/reference"] // Copy static files and CSS + JS from F# Formatting // Build documentation from `fsx` and `md` files in `docsrc/content` let buildDocumentation () = - let subdirs = Directory.EnumerateDirectories(content, "*", SearchOption.AllDirectories) - |> Seq.filter (fun x -> x.Contains "ja") - for dir in Seq.append [content] subdirs do + for dir in [content] do let sub = if dir.Length > content.Length then dir.Substring(content.Length + 1) else "." + printfn "root = %s" root Literate.ProcessDirectory ( dir, docTemplate, outputJa @@ sub, replacements = ("root", root)::info, layoutRoots = layoutRoots, generateAnchors = true ) diff --git a/fcs/fcs.props b/fcs/fcs.props index 2b897d37f3..e7cce1e0c3 100644 --- a/fcs/fcs.props +++ b/fcs/fcs.props @@ -3,10 +3,10 @@ - 14.0.2 + 16.0.2 - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools fsi.exe diff --git a/fcs/nuget/FSharp.Compiler.Service.MSBuild.v12.nuspec b/fcs/nuget/FSharp.Compiler.Service.MSBuild.v12.nuspec index e2fc6d2fd7..adf1e3726e 100644 --- a/fcs/nuget/FSharp.Compiler.Service.MSBuild.v12.nuspec +++ b/fcs/nuget/FSharp.Compiler.Service.MSBuild.v12.nuspec @@ -2,19 +2,21 @@ FSharp.Compiler.Service.MSBuild.v12 - - Adds legacy MSBuild 12.0 support to the F# compiler services package for - resolving references such as #r "System, Version=4.1.0.0,..." - + Adds legacy MSBuild 12.0 support to the F# compiler services package for resolving references such as #r "System, Version=4.1.0.0,..." en-US false - 14.0.2 + 16.0.2 Microsoft Corporation and F# community contributors https://github.com/fsharp/FSharp.Compiler.Service/blob/master/LICENSE https://github.com/fsharp/FSharp.Compiler.Service https://raw.github.com/fsharp/FSharp.Compiler.Service/master/misc/logo.png F#, fsharp, interactive, compiler, editor F# compiler services for creating IDE tools, language extensions and for F# embedding. + + + + + diff --git a/fcs/nuget/FSharp.Compiler.Service.ProjectCracker.nuspec b/fcs/nuget/FSharp.Compiler.Service.ProjectCracker.nuspec index f9275ce232..a19d9341f2 100644 --- a/fcs/nuget/FSharp.Compiler.Service.ProjectCracker.nuspec +++ b/fcs/nuget/FSharp.Compiler.Service.ProjectCracker.nuspec @@ -2,29 +2,27 @@ FSharp.Compiler.Service.ProjectCracker - - The F# compiler services package contains a custom build of the F# compiler that - exposes additional functionality for implementing F# language bindings, additional - tools based on the compiler or refactoring tools. The package also includes F# - interactive service that can be used for embedding F# scripting into your applications. - + The F# compiler services package contains a custom build of the F# compiler that exposes additional functionality for implementing F# language bindings, additional tools based on the compiler or refactoring tools. The package also includes F# interactive service that can be used for embedding F# scripting into your applications. en-US false - 14.0.2 + 16.0.2 Microsoft Corporation and F# community contributors https://github.com/fsharp/FSharp.Compiler.Service/blob/master/LICENSE https://github.com/fsharp/FSharp.Compiler.Service https://raw.github.com/fsharp/FSharp.Compiler.Service/master/misc/logo.png F#, fsharp, interactive, compiler, editor F# compiler services for creating IDE tools, language extensions and for F# embedding. + + + + + - - diff --git a/fcs/nuget/FSharp.Compiler.Service.nuspec b/fcs/nuget/FSharp.Compiler.Service.nuspec index 5b05dba395..fb4b6ac055 100644 --- a/fcs/nuget/FSharp.Compiler.Service.nuspec +++ b/fcs/nuget/FSharp.Compiler.Service.nuspec @@ -2,15 +2,10 @@ FSharp.Compiler.Service - - The F# compiler services package contains a custom build of the F# compiler that - exposes additional functionality for implementing F# language bindings, additional - tools based on the compiler or refactoring tools. The package also includes F# - interactive service that can be used for embedding F# scripting into your applications. - + The F# compiler services package contains a custom build of the F# compiler that exposes additional functionality for implementing F# language bindings, additional tools based on the compiler or refactoring tools. The package also includes F# interactive service that can be used for embedding F# scripting into your applications. en-US false - 14.0.2 + 16.0.2 Microsoft Corporation and F# community contributors https://github.com/fsharp/FSharp.Compiler.Service/blob/master/LICENSE https://github.com/fsharp/FSharp.Compiler.Service @@ -19,14 +14,13 @@ F# compiler services for creating IDE tools, language extensions and for F# embedding. - + - diff --git a/fcs/paket.dependencies b/fcs/paket.dependencies index e0071842a8..bfd298568f 100644 --- a/fcs/paket.dependencies +++ b/fcs/paket.dependencies @@ -1,4 +1,4 @@ -frameworks: net45 +framework: net45 source https://www.nuget.org/api/v2/ diff --git a/fcs/paket.lock b/fcs/paket.lock new file mode 100644 index 0000000000..2e454bee77 --- /dev/null +++ b/fcs/paket.lock @@ -0,0 +1,10 @@ +RESTRICTION: == net45 +NUGET + remote: https://www.nuget.org/api/v2 + FAKE (4.63.2) + FSharp.Compiler.Service (2.0.0.6) + FSharp.Formatting (2.14.4) + FSharp.Compiler.Service (2.0.0.6) + FSharpVSPowerTools.Core (>= 2.3 < 2.4) + FSharpVSPowerTools.Core (2.3) + FSharp.Compiler.Service (>= 2.0.0.3) diff --git a/fcs/samples/EditorService/App.config b/fcs/samples/EditorService/App.config index 677f8d8685..c923cce5cf 100644 --- a/fcs/samples/EditorService/App.config +++ b/fcs/samples/EditorService/App.config @@ -7,15 +7,7 @@ - - - - - - - - - + diff --git a/fcs/samples/EditorService/EditorService.fsproj b/fcs/samples/EditorService/EditorService.fsproj index 7daef7d9b5..e232d6c5ef 100644 --- a/fcs/samples/EditorService/EditorService.fsproj +++ b/fcs/samples/EditorService/EditorService.fsproj @@ -12,7 +12,6 @@ EditorService v4.5 EditorService - 4.4.0.0 true @@ -61,6 +60,5 @@ True - - + \ No newline at end of file diff --git a/fcs/samples/EditorService/Program.fs b/fcs/samples/EditorService/Program.fs index 20bf20cda7..40052ddce7 100644 --- a/fcs/samples/EditorService/Program.fs +++ b/fcs/samples/EditorService/Program.fs @@ -8,7 +8,8 @@ let checker = FSharpChecker.Create() let parseWithTypeInfo (file, input) = let checkOptions, _errors = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously - let untypedRes = checker.ParseFileInProject(file, input, checkOptions) |> Async.RunSynchronously + let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(checkOptions) + let untypedRes = checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously match checker.CheckFileInProject(untypedRes, file, 0, input, checkOptions) |> Async.RunSynchronously with | FSharpCheckFileAnswer.Succeeded(res) -> untypedRes, res diff --git a/fcs/samples/FscExe/App.config b/fcs/samples/FscExe/App.config index a895438e29..ab704c8783 100644 --- a/fcs/samples/FscExe/App.config +++ b/fcs/samples/FscExe/App.config @@ -1,9 +1,8 @@ - + - - + diff --git a/fcs/samples/FscExe/FscExe.fsproj b/fcs/samples/FscExe/FscExe.fsproj index 624f692136..e0ef6ebd4d 100644 --- a/fcs/samples/FscExe/FscExe.fsproj +++ b/fcs/samples/FscExe/FscExe.fsproj @@ -59,7 +59,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -73,6 +73,5 @@ True - - + \ No newline at end of file diff --git a/fcs/samples/FsiExe/App.config b/fcs/samples/FsiExe/App.config index ac481ec64a..2d8be79222 100644 --- a/fcs/samples/FsiExe/App.config +++ b/fcs/samples/FsiExe/App.config @@ -1,9 +1,8 @@ - + - - + diff --git a/fcs/samples/FsiExe/FsiExe.fsproj b/fcs/samples/FsiExe/FsiExe.fsproj index 18435f8ff0..ef52e8ee77 100644 --- a/fcs/samples/FsiExe/FsiExe.fsproj +++ b/fcs/samples/FsiExe/FsiExe.fsproj @@ -47,7 +47,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -71,5 +71,5 @@ True - + \ No newline at end of file diff --git a/fcs/samples/InteractiveService/App.config b/fcs/samples/InteractiveService/App.config index 423a5517bd..c485ef2b04 100644 --- a/fcs/samples/InteractiveService/App.config +++ b/fcs/samples/InteractiveService/App.config @@ -3,8 +3,5 @@ - - - - + \ No newline at end of file diff --git a/fcs/samples/InteractiveService/InteractiveService.fsproj b/fcs/samples/InteractiveService/InteractiveService.fsproj index c6b7ee6240..4efd2a56b1 100644 --- a/fcs/samples/InteractiveService/InteractiveService.fsproj +++ b/fcs/samples/InteractiveService/InteractiveService.fsproj @@ -45,7 +45,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -64,5 +64,5 @@ True - + \ No newline at end of file diff --git a/fcs/samples/Tokenizer/App.config b/fcs/samples/Tokenizer/App.config index 423a5517bd..c485ef2b04 100644 --- a/fcs/samples/Tokenizer/App.config +++ b/fcs/samples/Tokenizer/App.config @@ -3,8 +3,5 @@ - - - - + \ No newline at end of file diff --git a/fcs/samples/Tokenizer/Tokenizer.fsproj b/fcs/samples/Tokenizer/Tokenizer.fsproj index 6cbabe463e..a58aaf190f 100644 --- a/fcs/samples/Tokenizer/Tokenizer.fsproj +++ b/fcs/samples/Tokenizer/Tokenizer.fsproj @@ -45,7 +45,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -67,5 +67,5 @@ 11 - + \ No newline at end of file diff --git a/fcs/samples/UntypedTree/App.config b/fcs/samples/UntypedTree/App.config index 423a5517bd..c485ef2b04 100644 --- a/fcs/samples/UntypedTree/App.config +++ b/fcs/samples/UntypedTree/App.config @@ -3,8 +3,5 @@ - - - - + \ No newline at end of file diff --git a/fcs/samples/UntypedTree/Program.fs b/fcs/samples/UntypedTree/Program.fs index 58cc9a236d..3334b093ba 100644 --- a/fcs/samples/UntypedTree/Program.fs +++ b/fcs/samples/UntypedTree/Program.fs @@ -10,11 +10,8 @@ let checker = FSharpChecker.Create() // Get untyped tree for a specified input let getUntypedTree (file, input) = - // Get compiler options for a single script file - let checkOptions, _diagnostics = checker.GetProjectOptionsFromScript(file, input) |> Async.RunSynchronously - // Run the first phase (untyped parsing) of the compiler - - let untypedRes = checker.ParseFileInProject(file, input, checkOptions) |> Async.RunSynchronously + let parsingOptions = { FSharpParsingOptions.Default with SourceFiles = [| file |] } + let untypedRes = checker.ParseFile(file, input, parsingOptions) |> Async.RunSynchronously match untypedRes.ParseTree with | Some tree -> tree | None -> failwith "Something went wrong during parsing!" diff --git a/fcs/samples/UntypedTree/UntypedTree.fsproj b/fcs/samples/UntypedTree/UntypedTree.fsproj index c99bbab7eb..e8818931cd 100644 --- a/fcs/samples/UntypedTree/UntypedTree.fsproj +++ b/fcs/samples/UntypedTree/UntypedTree.fsproj @@ -45,7 +45,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools\FSharp.Core.dll + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools\FSharp.Core.dll true @@ -67,5 +67,5 @@ 11 - + \ No newline at end of file diff --git a/mono/FSharp.Compiler.Interactive.Settings/Makefile b/mono/FSharp.Compiler.Interactive.Settings/Makefile index 6865755fbf..bb894b5166 100644 --- a/mono/FSharp.Compiler.Interactive.Settings/Makefile +++ b/mono/FSharp.Compiler.Interactive.Settings/Makefile @@ -4,7 +4,7 @@ TOKEN=$(SIGN_TOKEN) include ../config.make -install: install-sdk-lib install-gac-lib +install: install-sdk-lib diff --git a/mono/FSharp.Compiler.Server.Shared/Makefile b/mono/FSharp.Compiler.Server.Shared/Makefile index 6afa337b06..213bc156d3 100644 --- a/mono/FSharp.Compiler.Server.Shared/Makefile +++ b/mono/FSharp.Compiler.Server.Shared/Makefile @@ -4,7 +4,7 @@ TOKEN=$(SIGN_TOKEN) include ../config.make -install: install-sdk-lib install-gac-lib +install: install-sdk-lib diff --git a/mono/FSharp.Core/Makefile b/mono/FSharp.Core/Makefile index 261e7fe387..13667a9161 100644 --- a/mono/FSharp.Core/Makefile +++ b/mono/FSharp.Core/Makefile @@ -5,6 +5,6 @@ TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) include ../config.make -install: install-sdk-lib install-gac-lib +install: install-sdk-lib diff --git a/mono/appveyor.ps1 b/mono/appveyor.ps1 index 1018aa603b..b26a52d32f 100644 --- a/mono/appveyor.ps1 +++ b/mono/appveyor.ps1 @@ -1,6 +1,6 @@ # the version under development, update after a release -$version = '4.1.14' +$version = '4.1.28' function isVersionTag($tag){ $v = New-Object Version @@ -27,5 +27,4 @@ function pack($nuspec){ & $nuget pack $nuspec -BasePath "$dir" -Version $version -OutputDirectory "$packagesOutDir" -NoDefaultExcludes -Verbosity d } -pack(gi .\FSharp.Core.Nuget\FSharp.Core.nuspec) pack(gi .\FSharp.Compiler.Tools.Nuget\FSharp.Compiler.Tools.nuspec) diff --git a/mono/build-netcore.bat b/mono/build-netcore.bat deleted file mode 100755 index 1c28a96219..0000000000 --- a/mono/build-netcore.bat +++ /dev/null @@ -1,22 +0,0 @@ -@echo off - -:: Check prerequisites -set _msbuildexe="%ProgramFiles(x86)%\MSBuild\14.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles%\MSBuild\14.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles(x86)%\MSBuild\12.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles%\MSBuild\12.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% echo Error: Could not find MSBuild.exe. Please see http://www.microsoft.com/en-us/download/details.aspx?id=40760. && goto :eof - -set msbuildflags=/maxcpucount - -::Build - -%_msbuildexe% %msbuildflags% lib\netcore\build-fsc-netcore.proj /v:n -@if ERRORLEVEL 1 echo Error: "%_msbuildexe% %msbuildflags% lib\netcore\build-fsc-netcore.proj" failed && goto :failure - - -@echo "Finished" -goto :eof - -:failure -exit /b 1 diff --git a/mono/build.bat b/mono/build.bat deleted file mode 100644 index 330f9fd108..0000000000 --- a/mono/build.bat +++ /dev/null @@ -1,45 +0,0 @@ -@echo off - -:: Check prerequisites -set _msbuildexe="%ProgramFiles(x86)%\MSBuild\14.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles%\MSBuild\14.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles(x86)%\MSBuild\12.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% set _msbuildexe="%ProgramFiles%\MSBuild\12.0\Bin\MSBuild.exe" -if not exist %_msbuildexe% echo Error: Could not find MSBuild.exe. Please see http://www.microsoft.com/en-us/download/details.aspx?id=40760. && goto :eof - -set msbuildflags=/maxcpucount -set _ngenexe="%SystemRoot%\Microsoft.NET\Framework\v4.0.30319\ngen.exe" -if not exist %_ngenexe% echo Note: Could not find ngen.exe. - -::Build - -%_ngenexe% install .\.nuget\NuGet.exe - -.\.nuget\NuGet.exe restore packages.config -PackagesDirectory packages -ConfigFile .nuget\nuget.config -@if ERRORLEVEL 1 echo Error: Nuget restore failed && goto :failure - -%_ngenexe% install packages\FSharp.Compiler.Tools.4.0.1.21\tools\fsc.exe - -set BUILD_NET40=1 -set BUILD_NET40_FSHARP_CORE=1 -set BUILD_PORTABLE=1 -set TEST_NET40_COREUNIT_SUITE=1 -set TEST_PORTABLE_COREUNIT_SUITE=1 - -%_msbuildexe% src\fsharp-proto-build.proj -@if ERRORLEVEL 1 echo Error: "%_msbuildexe% src\fsharp-proto-build.proj" failed && goto :failure - -%_ngenexe% install Proto\net440\bin\fsc-proto.exe - -%_msbuildexe% %msbuildflags% build-everything.proj /p:TargetDotnetProfile=net40 /p:Configuration=Release -@if ERRORLEVEL 1 echo Error: "%_msbuildexe% %msbuildflags% src\fsharp-library-build.proj /p:TargetDotnetProfile=net40 /p:Configuration=Release" failed && goto :failure - -%_msbuildexe% %msbuildflags% src/fsharp/FSharp.Core/FSharp.Core.fsproj /p:TargetDotnetProfile=monotouch /p:Configuration=Release /p:KeyFile=..\..\..\mono\mono.snk -@if ERRORLEVEL 1 echo Error: "%_msbuildexe% %msbuildflags% src\fsharp-library-build.proj /p:TargetDotnetProfile=monotouch /p:Configuration=Release /p:KeyFile=..\..\..\mono.snk" failed && goto :failure - - -@echo "Finished" -goto :eof - -:failure -exit /b 1 diff --git a/mono/config.make.in b/mono/config.make.in index ef700f132b..3106ab99fd 100644 --- a/mono/config.make.in +++ b/mono/config.make.in @@ -1,6 +1,6 @@ DEFAULT: all -.PHONY: install-sdk-lib install-gac-lib +.PHONY: install-sdk-lib prefix := @prefix@ topdir := @abs_top_srcdir@/ @@ -9,17 +9,6 @@ libdir := ${prefix}/lib/ bindir := ${prefix}/bin/ monobindir := @MONOBINDIR@ monolibdir := @MONOLIBDIR@ -monogacdir := @MONOGACDIR@ - -monogacdir40 := @MONOGACDIR40@ - -pclenabled47 := @PCLENABLED47@ -pclenabled7 := @PCLENABLED7@ -pclenabled78 := @PCLENABLED78@ -pclenabled259 := @PCLENABLED259@ -monotouchenabled := @MONOTOUCHENABLED@ -monodroidenabled := @MONODROIDENABLED@ -xamarinmacenabled := @XAMARINMACENABLED@ monodir := ${libdir}mono @@ -30,6 +19,7 @@ DISTVERSION = 201011 # Version number mappings for various versions of FSharp.Core + ifeq (x-$(TargetDotnetProfile)-,x-net40-) ifeq (x-$(FSharpCoreBackVersion)-,x--) @@ -105,7 +95,7 @@ INSTALL = $(SHELL) $(topdir)/mono/install-sh INSTALL_BIN = $(INSTALL) -c -m 755 INSTALL_LIB = $(INSTALL_BIN) -XBUILD = @XBUILD@ +MSBUILD = @MSBUILD@ EXTRA_DIST = configure NO_DIST = .gitignore lib/debug lib/proto lib/release @@ -201,6 +191,18 @@ install-sdk-lib: $(INSTALL_LIB) $(tmpdir)Microsoft.Portable.FSharp.Targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v12.0/FSharp/; \ $(INSTALL_LIB) $(tmpdir)Microsoft.Portable.FSharp.Targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v14.0/FSharp/; \ $(INSTALL_LIB) $(tmpdir)Microsoft.Portable.FSharp.Targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v15.0/FSharp/; \ + \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.props $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.props $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v11.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.props $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v12.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.props $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v14.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.props $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v15.0/FSharp/; \ + \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v11.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v12.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v14.0/FSharp/; \ + $(INSTALL_LIB) $(outdir)Microsoft.FSharp.NetSdk.targets $(DESTDIR)$(monodir)/xbuild/Microsoft/VisualStudio/v15.0/FSharp/; \ fi @if test x-$(outsuffix) = x-net40; then \ if test -e $(outdir)$(NAME).dll; then \ @@ -248,52 +250,6 @@ install-sdk-lib: $(INSTALL_LIB) $(outdir)$(NAME).dll $(DESTDIR)$(monodir)/fsharp/api/$(PCLPATH)/$(VERSION)/; \ fi -# Install the library binaries in the GAC directory, -install-gac-lib: - $(eval TARGET = "4.5") - @echo "Installing $(ASSEMBLY)" - @if test "x$(DELAY_SIGN)" = "x1"; then \ - echo "Signing $(outdir)$(ASSEMBLY) with Mono key"; \ - $(monobindir)/sn -q -R $(outdir)$(ASSEMBLY) $(topdir)mono/mono.snk; \ - fi - @if test -e $(outdir)$(NAME).dll; then \ - if test x-$(NAME) = x-FSharp.Core && test x-$(PKGINSTALL) = x-yes; then \ - echo "Using gacutil to install $(outdir)$(ASSEMBLY) into GAC root $(DESTDIR)$(libdir) as package $(TARGET)"; \ - $(monobindir)/gacutil -i $(outdir)$(ASSEMBLY) -root $(DESTDIR)$(libdir) -package $(TARGET); \ - else \ - echo "Installing $(outdir)$(NAME).dll to $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/"; \ - mkdir -p $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - $(INSTALL_LIB) $(outdir)$(NAME).dll $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - fi; \ - fi - - @if test -e $(outdir)$(NAME).xml; then \ - echo "Installing $(outdir)$(NAME).xml into $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/"; \ - mkdir -p $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - $(INSTALL_LIB) $(outdir)$(NAME).xml $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - if test x-$(PKGINSTALL) = x-yes && test x-$(NAME) = x-FSharp.Core; then \ - echo "Using linking to ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).xml to install $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).xml"; \ - ln -fs ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).xml $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).xml; \ - fi; \ - fi - @if test -e $(outdir)$(NAME).sigdata; then \ - echo "Installing $(outdir)$(NAME).sigdata into $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/"; \ - mkdir -p $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - $(INSTALL_LIB) $(outdir)$(NAME).sigdata $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - if test x-$(PKGINSTALL) = x-yes; then \ - echo "Using linking to ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).sigdata to install $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).sigdata"; \ - ln -fs ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).sigdata $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).sigdata; \ - fi; \ - fi - @if test -e $(outdir)$(NAME).optdata; then \ - echo "Installing $(outdir)$(NAME).optdata into $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/"; \ - mkdir -p $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - $(INSTALL_LIB) $(outdir)$(NAME).optdata $(DESTDIR)$(monodir)/gac/$(NAME)/$(VERSION)__$(TOKEN)/; \ - if test x-$(PKGINSTALL) = x-yes; then \ - echo "Using linking to ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).optdata to install $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).optdata"; \ - ln -fs ../gac/$(NAME)/$(VERSION)__$(TOKEN)/$(NAME).optdata $(DESTDIR)$(libdir)mono/$(TARGET)/$(NAME).optdata; \ - fi; \ - fi # The binaries fsc.exe and fsi.exe only get installed for Mono 4.5 profile diff --git a/mono/policy.2.0.FSharp.Core/Makefile b/mono/policy.2.0.FSharp.Core/Makefile deleted file mode 100644 index b224aca1d1..0000000000 --- a/mono/policy.2.0.FSharp.Core/Makefile +++ /dev/null @@ -1,22 +0,0 @@ -NAME=policy.2.0.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib - - - diff --git a/mono/policy.2.0.FSharp.Core/policy.2.0.FSharp.Core.dll.config b/mono/policy.2.0.FSharp.Core/policy.2.0.FSharp.Core.dll.config deleted file mode 100644 index b533a63135..0000000000 --- a/mono/policy.2.0.FSharp.Core/policy.2.0.FSharp.Core.dll.config +++ /dev/null @@ -1,17 +0,0 @@ - - - - - - - - - - - - - - - - - diff --git a/mono/policy.2.3.FSharp.Core/Makefile b/mono/policy.2.3.FSharp.Core/Makefile deleted file mode 100644 index 6158f76d21..0000000000 --- a/mono/policy.2.3.FSharp.Core/Makefile +++ /dev/null @@ -1,22 +0,0 @@ -NAME=policy.2.3.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -# override the targets to build the assembly - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib - diff --git a/mono/policy.2.3.FSharp.Core/policy.2.3.FSharp.Core.dll.config b/mono/policy.2.3.FSharp.Core/policy.2.3.FSharp.Core.dll.config deleted file mode 100644 index f211873a0a..0000000000 --- a/mono/policy.2.3.FSharp.Core/policy.2.3.FSharp.Core.dll.config +++ /dev/null @@ -1,18 +0,0 @@ - - - - - - - - - - - - - - - - - - diff --git a/mono/policy.3.259.FSharp.Core/Makefile b/mono/policy.3.259.FSharp.Core/Makefile deleted file mode 100644 index e51e01099a..0000000000 --- a/mono/policy.3.259.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.3.259.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.3.259.FSharp.Core/policy.3.259.FSharp.Core.dll.config b/mono/policy.3.259.FSharp.Core/policy.3.259.FSharp.Core.dll.config deleted file mode 100644 index c6cf741589..0000000000 --- a/mono/policy.3.259.FSharp.Core/policy.3.259.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.3.3.FSharp.Core/Makefile b/mono/policy.3.3.FSharp.Core/Makefile deleted file mode 100644 index 7384f56497..0000000000 --- a/mono/policy.3.3.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.3.3.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.3.3.FSharp.Core/policy.3.3.FSharp.Core.dll.config b/mono/policy.3.3.FSharp.Core/policy.3.3.FSharp.Core.dll.config deleted file mode 100644 index eecc0dddec..0000000000 --- a/mono/policy.3.3.FSharp.Core/policy.3.3.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.3.47.FSharp.Core/Makefile b/mono/policy.3.47.FSharp.Core/Makefile deleted file mode 100644 index 34027eaafd..0000000000 --- a/mono/policy.3.47.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.3.47.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.3.47.FSharp.Core/policy.3.47.FSharp.Core.dll.config b/mono/policy.3.47.FSharp.Core/policy.3.47.FSharp.Core.dll.config deleted file mode 100644 index f5eaaa9905..0000000000 --- a/mono/policy.3.47.FSharp.Core/policy.3.47.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.3.7.FSharp.Core/Makefile b/mono/policy.3.7.FSharp.Core/Makefile deleted file mode 100644 index 1a0420e952..0000000000 --- a/mono/policy.3.7.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.3.7.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.3.7.FSharp.Core/policy.3.7.FSharp.Core.dll.config b/mono/policy.3.7.FSharp.Core/policy.3.7.FSharp.Core.dll.config deleted file mode 100644 index 791007a1d9..0000000000 --- a/mono/policy.3.7.FSharp.Core/policy.3.7.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.3.78.FSharp.Core/Makefile b/mono/policy.3.78.FSharp.Core/Makefile deleted file mode 100644 index 59d9df135f..0000000000 --- a/mono/policy.3.78.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.3.78.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.3.78.FSharp.Core/policy.3.78.FSharp.Core.dll.config b/mono/policy.3.78.FSharp.Core/policy.3.78.FSharp.Core.dll.config deleted file mode 100644 index bd7261c472..0000000000 --- a/mono/policy.3.78.FSharp.Core/policy.3.78.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.4.0.FSharp.Core/Makefile b/mono/policy.4.0.FSharp.Core/Makefile deleted file mode 100644 index 6b71e4fc0b..0000000000 --- a/mono/policy.4.0.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.4.0.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.4.0.FSharp.Core/policy.4.0.FSharp.Core.dll.config b/mono/policy.4.0.FSharp.Core/policy.4.0.FSharp.Core.dll.config deleted file mode 100644 index 88b8cf82c9..0000000000 --- a/mono/policy.4.0.FSharp.Core/policy.4.0.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.4.3.FSharp.Core/Makefile b/mono/policy.4.3.FSharp.Core/Makefile deleted file mode 100644 index 80ca0747c7..0000000000 --- a/mono/policy.4.3.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.4.3.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.4.3.FSharp.Core/policy.4.3.FSharp.Core.dll.config b/mono/policy.4.3.FSharp.Core/policy.4.3.FSharp.Core.dll.config deleted file mode 100644 index d84baa71b5..0000000000 --- a/mono/policy.4.3.FSharp.Core/policy.4.3.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/policy.4.4.FSharp.Core/Makefile b/mono/policy.4.4.FSharp.Core/Makefile deleted file mode 100644 index b55467817f..0000000000 --- a/mono/policy.4.4.FSharp.Core/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -NAME=policy.4.4.FSharp.Core -ASSEMBLY = $(NAME).dll -DELAY_SIGN=1 -TOKEN=$(FSCORE_DELAY_SIGN_TOKEN) - -include ../config.make - -$(outdir)$(NAME).dll: $(NAME).dll.config - @mkdir -p $(@D) - cp $(NAME).dll.config $(@D) - $(monobindir)/al /link:$(NAME).dll.config /out:$@ /delaysign /keyfile:$(topdir)mono/msfinal.pub - -build: - $(MAKE) $(outdir)$(NAME).dll - -clean: - -rm -f $(outdir)$(NAME).dll - -install: install-sdk-lib install-gac-lib \ No newline at end of file diff --git a/mono/policy.4.4.FSharp.Core/policy.4.4.FSharp.Core.dll.config b/mono/policy.4.4.FSharp.Core/policy.4.4.FSharp.Core.dll.config deleted file mode 100644 index a76ad3acd4..0000000000 --- a/mono/policy.4.4.FSharp.Core/policy.4.4.FSharp.Core.dll.config +++ /dev/null @@ -1,11 +0,0 @@ - - - - - - - - - - - diff --git a/mono/prepare-mono.sh b/mono/prepare-mono.sh index 9354510319..77f3e18b99 100755 --- a/mono/prepare-mono.sh +++ b/mono/prepare-mono.sh @@ -21,9 +21,9 @@ esac # On Linux (or at least, Ubuntu), when building with Mono, need to install the mono-devel package first. if [ $OS = 'Linux' ]; then sudo apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 3FA7E0328081BFF6A14DA29AA6A19B38D3D831EF - echo "deb http://download.mono-project.com/repo/debian wheezy main" | sudo tee /etc/apt/sources.list.d/mono-xamarin.list + echo "deb http://download.mono-project.com/repo/ubuntu trusty main" | sudo tee /etc/apt/sources.list.d/mono-xamarin.list sudo apt-get update - sudo apt-get -y install mono-devel + sudo apt-get -y install mono-devel msbuild fi # Check if SSL certificates have been imported into Mono's certificate store. @@ -54,10 +54,10 @@ fi) fi) #TODO: work out how to avoid the need for this -echo "chmod u+x packages/FSharp.Compiler.Tools.4.1.23/tools/fsi.exe" -echo "chmod u+x packages/FsLexYacc.7.0.4/build/fslex.exe" -echo "chmod u+x packages/FsLexYacc.7.0.4/build/fsyacc.exe" -chmod u+x packages/FSharp.Compiler.Tools.4.1.23/tools/fsi.exe +echo "chmod u+x packages/FSharp.Compiler.Tools.4.1.27/tools/fsi.exe" +echo "chmod u+x packages/FsLexYacc.7.0.6/build/fslex.exe" +echo "chmod u+x packages/FsLexYacc.7.0.6/build/fsyacc.exe" +chmod u+x packages/FSharp.Compiler.Tools.4.1.27/tools/fsi.exe chmod u+x packages/FsLexYacc.7.0.6/build/fslex.exe chmod u+x packages/FsLexYacc.7.0.6/build/fsyacc.exe diff --git a/mono/travis-autogen.sh b/mono/travis-autogen.sh index e4725f81cb..9c356b0862 100755 --- a/mono/travis-autogen.sh +++ b/mono/travis-autogen.sh @@ -3,7 +3,8 @@ echo "TRAVIS_OS_NAME=$TRAVIS_OS_NAME" if [ "$TRAVIS_OS_NAME" = "osx" ]; then - monoVer=$(mono --version | head -n 1 | cut -d' ' -f 5) + # Parse 'Mono JIT compiler version 5.0.1.1' to '5.0.1' + monoVer=$(mono --version | head -n 1 | cut -d' ' -f 5 | cut -d'.' -f 1-3) prefix="/Library/Frameworks/Mono.framework/Versions/$monoVer"; else prefix="/usr"; diff --git a/packages.config b/packages.config index 57ee60f4b1..ff5ad0ff98 100644 --- a/packages.config +++ b/packages.config @@ -12,7 +12,7 @@ - + @@ -39,11 +39,23 @@ - + + + + + + + + + + + + + diff --git a/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs index ae8a46aad6..78ed928905 100644 --- a/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs +++ b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs @@ -171,7 +171,7 @@ - + diff --git a/setup/packages.config b/setup/packages.config index b2376a2008..aded14292c 100644 --- a/setup/packages.config +++ b/setup/packages.config @@ -1,6 +1,6 @@ - + diff --git a/src/FSharpSource.Profiles.targets b/src/FSharpSource.Profiles.targets index c2c58cdf81..adafba0eae 100644 --- a/src/FSharpSource.Profiles.targets +++ b/src/FSharpSource.Profiles.targets @@ -56,6 +56,7 @@ $(DefineConstants);FX_RESHAPED_MSBUILD $(DefineConstants);FSI_TODO_NETCORE $(OtherFlags) --simpleresolution + netstandard1.6 diff --git a/src/FSharpSource.Settings.targets b/src/FSharpSource.Settings.targets index 718817a879..7f964f14be 100644 --- a/src/FSharpSource.Settings.targets +++ b/src/FSharpSource.Settings.targets @@ -35,6 +35,7 @@ 2.3.0-beta2-61719-01 15.0 15.0.26201 + 1.3.1 Microsoft.VSSDK.BuildTools.15.0.26201 15.3.23 @@ -140,7 +141,7 @@ - $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.23\tools + $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools diff --git a/src/FSharpSource.targets b/src/FSharpSource.targets index ef32269142..5d09fd3373 100644 --- a/src/FSharpSource.targets +++ b/src/FSharpSource.targets @@ -157,7 +157,7 @@ $(FSharpSourcesRoot)\..\$(Configuration)\$(ProtoFlavour)\bin $(FSharpSourcesRoot)\..\Tools\dotnet20\sdk\2.0.0-preview2-006502\FSharp - ..\packages\FSharp.Compiler.Tools.4.1.23\tools\Microsoft.FSharp.Targets + ..\packages\FSharp.Compiler.Tools.4.1.27\tools\Microsoft.FSharp.Targets $(FSharpSourcesRoot)\..\Tools\dotnet20 @@ -170,7 +170,7 @@ $(FSharpSourcesRoot)\..\$(Configuration)\$(ProtoFlavour)\bin - ..\packages\FSharp.Compiler.Tools.4.1.23\tools\Microsoft.FSharp.Targets + ..\packages\FSharp.Compiler.Tools.4.1.27\tools\Microsoft.FSharp.Targets @@ -360,6 +360,9 @@ + + + + + + + + + + + + - + - + - + diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index d3c0bd5b00..763235afa1 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -149,9 +149,9 @@ let wordsOfNoArgInstr, isNoArgInstr = let t = lazy (let t = HashMultiMap(300, HashIdentity.Structural) - noArgInstrs |> Lazy.force |> List.iter (fun (x,mk) -> t.Add(mk,x)) ; + noArgInstrs |> Lazy.force |> List.iter (fun (x, mk) -> t.Add(mk, x)) ; t) - (fun s -> (Lazy.force t).[s]), + (fun s -> (Lazy.force t).[s]), (fun s -> (Lazy.force t).ContainsKey s) #endif @@ -159,8 +159,8 @@ let wordsOfNoArgInstr, isNoArgInstr = // Instructions are preceded by prefixes, e.g. ".tail" etc. // -------------------------------------------------------------------- -let mk_stind (nm,dt) = (nm, (fun () -> I_stind(Aligned,Nonvolatile,dt))) -let mk_ldind (nm,dt) = (nm, (fun () -> I_ldind(Aligned,Nonvolatile,dt))) +let mk_stind (nm, dt) = (nm, (fun () -> I_stind(Aligned, Nonvolatile, dt))) +let mk_ldind (nm, dt) = (nm, (fun () -> I_ldind(Aligned, Nonvolatile, dt))) // -------------------------------------------------------------------- // Parsing only... Tables of different types of instructions. @@ -192,7 +192,7 @@ type LazyInstrTable<'T> = Lazy> // -------------------------------------------------------------------- let NoArgInstrs = - lazy (((noArgInstrs |> Lazy.force |> List.map (fun (nm,i) -> (nm,(fun () -> i)))) @ + lazy (((noArgInstrs |> Lazy.force |> List.map (fun (nm, i) -> (nm, (fun () -> i)))) @ [ (mk_stind (["stind";"u"], DT_I)); (mk_stind (["stind";"i"], DT_I)); (mk_stind (["stind";"u1"], DT_I1));(* ILX EQUIVALENT *) @@ -218,8 +218,8 @@ let NoArgInstrs = (mk_ldind (["ldind";"r4"], DT_R4)); (mk_ldind (["ldind";"r8"], DT_R8)); (mk_ldind (["ldind";"ref"], DT_REF)); - (["cpblk"], (fun () -> I_cpblk(Aligned,Nonvolatile))); - (["initblk"], (fun () -> I_initblk(Aligned,Nonvolatile))); + (["cpblk"], (fun () -> I_cpblk(Aligned, Nonvolatile))); + (["initblk"], (fun () -> I_initblk(Aligned, Nonvolatile))); ] ) : NoArgInstr InstrTable);; @@ -231,14 +231,14 @@ let Int32Instrs = (["ldc";"i4";"s"], (fun x -> ((mkLdcInt32 x)))); ] : Int32Instr InstrTable) let Int32Int32Instrs = - lazy ([ (["ldlen";"multi"], (fun (x,y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable) + lazy ([ (["ldlen";"multi"], (fun (x, y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable) let DoubleInstrs = lazy ([ (["ldc";"r4"], (fun x -> (AI_ldc (DT_R4, x)))); (["ldc";"r8"], (fun x -> (AI_ldc (DT_R8, x)))); ] : DoubleInstr InstrTable) let MethodSpecInstrs = - lazy ([ ( (["call"], (fun (mspec,y) -> I_call (Normalcall,mspec,y)))) ] : InstrTable) + lazy ([ ( (["call"], (fun (mspec, y) -> I_call (Normalcall, mspec, y)))) ] : InstrTable) let StringInstrs = lazy ([ (["ldstr"], (fun x -> I_ldstr x)); ] : InstrTable) @@ -248,10 +248,10 @@ let TokenInstrs = let TypeInstrs = - lazy ([ (["ldelema"], (fun x -> I_ldelema (NormalAddress,false,ILArrayShape.SingleDimensional,x))); - (["ldelem";"any"], (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))); + lazy ([ (["ldelema"], (fun x -> I_ldelema (NormalAddress, false, ILArrayShape.SingleDimensional, x))); + (["ldelem";"any"], (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional, x))); (["stelem";"any"], (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x))); - (["newarr"], (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))); + (["newarr"], (fun x -> I_newarr (ILArrayShape.SingleDimensional, x))); (["castclass"], (fun x -> I_castclass x)); (["ilzero"], (fun x -> EI_ilzero x)); (["isinst"], (fun x -> I_isinst x)); @@ -259,16 +259,16 @@ let TypeInstrs = (["unbox";"any"], (fun x -> I_unbox_any x)); ] : InstrTable) let IntTypeInstrs = - lazy ([ (["ldelem";"multi"], (fun (x,y) -> (I_ldelem_any (ILArrayShape.FromRank x,y)))); - (["stelem";"multi"], (fun (x,y) -> (I_stelem_any (ILArrayShape.FromRank x,y)))); - (["newarr";"multi"], (fun (x,y) -> (I_newarr (ILArrayShape.FromRank x,y)))); - (["ldelema";"multi"], (fun (x,y) -> (I_ldelema (NormalAddress,false,ILArrayShape.FromRank x,y)))); ] : InstrTable) + lazy ([ (["ldelem";"multi"], (fun (x, y) -> (I_ldelem_any (ILArrayShape.FromRank x, y)))); + (["stelem";"multi"], (fun (x, y) -> (I_stelem_any (ILArrayShape.FromRank x, y)))); + (["newarr";"multi"], (fun (x, y) -> (I_newarr (ILArrayShape.FromRank x, y)))); + (["ldelema";"multi"], (fun (x, y) -> (I_ldelema (NormalAddress, false, ILArrayShape.FromRank x, y)))); ] : InstrTable) let ValueTypeInstrs = lazy ([ (["cpobj"], (fun x -> I_cpobj x)); (["initobj"], (fun x -> I_initobj x)); - (["ldobj"], (fun z -> I_ldobj (Aligned,Nonvolatile,z))); - (["stobj"], (fun z -> I_stobj (Aligned,Nonvolatile,z))); + (["ldobj"], (fun z -> I_ldobj (Aligned, Nonvolatile, z))); + (["stobj"], (fun z -> I_stobj (Aligned, Nonvolatile, z))); (["sizeof"], (fun x -> I_sizeof x)); (["box"], (fun x -> I_box x)); (["unbox"], (fun x -> I_unbox x)); ] : InstrTable) diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 2bb50daa0a..6c98fc605b 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -271,11 +271,11 @@ and goutput_permission _env os p = match p with | PermissionSet (sa,b) -> - output_string os " .permissionset "; - output_security_action os sa ; - output_string os " = (" ; - output_bytes os b ; - output_string os ")" ; + output_string os " .permissionset " + output_security_action os sa + output_string os " = (" + output_bytes os b + output_string os ")" and goutput_security_decls env os (ps: ILPermissions) = output_seq " " (goutput_permission env) os ps.AsList diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 2d42a6abd8..647d30457e 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -43,7 +43,7 @@ let checking = false let logging = false let _ = if checking then dprintn "warning : Ilread.checking is on" -let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x),0) +let singleOfBits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) let doubleOfBits (x:int64) = System.BitConverter.Int64BitsToDouble(x) //--------------------------------------------------------------------- @@ -57,29 +57,29 @@ let uncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx) let i32ToUncodedToken tok = let idx = tok &&& 0xffffff let tab = tok >>>& 24 - (TableName.FromIndex tab, idx) + (TableName.FromIndex tab, idx) [] type TaggedIndex<'T> = val tag: 'T val index : int32 - new(tag,index) = { tag=tag; index=index } + new(tag, index) = { tag=tag; index=index } -let uncodedTokenToTypeDefOrRefOrSpec (tab,tok) = +let uncodedTokenToTypeDefOrRefOrSpec (tab, tok) = let tag = if tab = TableNames.TypeDef then tdor_TypeDef elif tab = TableNames.TypeRef then tdor_TypeRef elif tab = TableNames.TypeSpec then tdor_TypeSpec else failwith "bad table in uncodedTokenToTypeDefOrRefOrSpec" - TaggedIndex(tag,tok) + TaggedIndex(tag, tok) -let uncodedTokenToMethodDefOrRef (tab,tok) = +let uncodedTokenToMethodDefOrRef (tab, tok) = let tag = if tab = TableNames.Method then mdor_MethodDef elif tab = TableNames.MemberRef then mdor_MemberRef else failwith "bad table in uncodedTokenToMethodDefOrRef" - TaggedIndex(tag,tok) + TaggedIndex(tag, tok) let (|TaggedIndex|) (x:TaggedIndex<'T>) = x.tag, x.index let tokToTaggedIdx f nbits tok = @@ -117,9 +117,9 @@ module MemoryMapping = [] extern HANDLE CreateFile (string _lpFileName, int _dwDesiredAccess, - int _dwShareMode, + int _dwShareMode, HANDLE _lpSecurityAttributes, - int _dwCreationDisposition, + int _dwCreationDisposition, int _dwFlagsAndAttributes, HANDLE _hTemplateFile) @@ -128,13 +128,13 @@ module MemoryMapping = HANDLE _lpAttributes, int _flProtect, int _dwMaximumSizeLow, - int _dwMaximumSizeHigh, + int _dwMaximumSizeHigh, string _lpName) [] extern ADDR MapViewOfFile (HANDLE _hFileMappingObject, int _dwDesiredAccess, - int _dwFileOffsetHigh, + int _dwFileOffsetHigh, int _dwFileOffsetLow, SIZE_T _dwNumBytesToMap) @@ -164,12 +164,12 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = failwithf "CreateFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) let protection = 0x00000002 (* ReadOnly *) //printf "OK! hFile = %Lx\n" (hFile.ToInt64()) - let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0,0, null ) + let hMap = MemoryMapping.CreateFileMapping (hFile, IntPtr.Zero, protection, 0, 0, null ) ignore(MemoryMapping.CloseHandle(hFile)) if hMap.Equals(MemoryMapping.NULL_HANDLE) then failwithf "CreateFileMapping(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) - let start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ,0,0,0n) + let start = MemoryMapping.MapViewOfFile (hMap, MemoryMapping.MAP_READ, 0, 0, 0n) if start.Equals(IntPtr.Zero) then failwithf "MapViewOfFile(0x%08x)" ( Marshal.GetHRForLastWin32Error() ) @@ -183,7 +183,7 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = override m.ReadBytes i len = let res = Bytes.zeroCreate len - Marshal.Copy(m.Addr i, res, 0,len) + Marshal.Copy(m.Addr i, res, 0, len) res override m.ReadInt32 i = @@ -327,21 +327,21 @@ let sigptrGetByte (bytes:byte[]) sigptr = bytes.[sigptr], sigptr + 1 let sigptrGetBool bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr - (b0 = 0x01uy) ,sigptr + let b0, sigptr = sigptrGetByte bytes sigptr + (b0 = 0x01uy) , sigptr let sigptrGetSByte bytes sigptr = - let i,sigptr = sigptrGetByte bytes sigptr - sbyte i,sigptr + let i, sigptr = sigptrGetByte bytes sigptr + sbyte i, sigptr let sigptrGetUInt16 bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr - let b1,sigptr = sigptrGetByte bytes sigptr - uint16 (int b0 ||| (int b1 <<< 8)),sigptr + let b0, sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr + uint16 (int b0 ||| (int b1 <<< 8)), sigptr let sigptrGetInt16 bytes sigptr = - let u,sigptr = sigptrGetUInt16 bytes sigptr - int16 u,sigptr + let u, sigptr = sigptrGetUInt16 bytes sigptr + int16 u, sigptr let sigptrGetInt32 bytes sigptr = sigptrCheck bytes sigptr @@ -353,43 +353,43 @@ let sigptrGetInt32 bytes sigptr = res, sigptr + 4 let sigptrGetUInt32 bytes sigptr = - let u,sigptr = sigptrGetInt32 bytes sigptr - uint32 u,sigptr + let u, sigptr = sigptrGetInt32 bytes sigptr + uint32 u, sigptr let sigptrGetUInt64 bytes sigptr = - let u0,sigptr = sigptrGetUInt32 bytes sigptr - let u1,sigptr = sigptrGetUInt32 bytes sigptr - (uint64 u0 ||| (uint64 u1 <<< 32)),sigptr + let u0, sigptr = sigptrGetUInt32 bytes sigptr + let u1, sigptr = sigptrGetUInt32 bytes sigptr + (uint64 u0 ||| (uint64 u1 <<< 32)), sigptr let sigptrGetInt64 bytes sigptr = - let u,sigptr = sigptrGetUInt64 bytes sigptr - int64 u,sigptr + let u, sigptr = sigptrGetUInt64 bytes sigptr + int64 u, sigptr let sigptrGetSingle bytes sigptr = - let u,sigptr = sigptrGetInt32 bytes sigptr - singleOfBits u,sigptr + let u, sigptr = sigptrGetInt32 bytes sigptr + singleOfBits u, sigptr let sigptrGetDouble bytes sigptr = - let u,sigptr = sigptrGetInt64 bytes sigptr - doubleOfBits u,sigptr + let u, sigptr = sigptrGetInt64 bytes sigptr + doubleOfBits u, sigptr let sigptrGetZInt32 bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes sigptr if b0 <= 0x7Fuy then int b0, sigptr elif b0 <= 0xBFuy then let b0 = b0 &&& 0x7Fuy - let b1,sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr (int b0 <<< 8) ||| int b1, sigptr else let b0 = b0 &&& 0x3Fuy - let b1,sigptr = sigptrGetByte bytes sigptr - let b2,sigptr = sigptrGetByte bytes sigptr - let b3,sigptr = sigptrGetByte bytes sigptr + let b1, sigptr = sigptrGetByte bytes sigptr + let b2, sigptr = sigptrGetByte bytes sigptr + let b3, sigptr = sigptrGetByte bytes sigptr (int b0 <<< 24) ||| (int b1 <<< 16) ||| (int b2 <<< 8) ||| int b3, sigptr let rec sigptrFoldAcc f n (bytes:byte[]) (sigptr:int) i acc = if i < n then - let x,sp = f bytes sigptr + let x, sp = f bytes sigptr sigptrFoldAcc f n bytes sp (i+1) (x::acc) else List.rev acc, sigptr @@ -409,8 +409,8 @@ let sigptrGetBytes n (bytes:byte[]) sigptr = res, sigptr + n let sigptrGetString n bytes sigptr = - let bytearray,sigptr = sigptrGetBytes n bytes sigptr - (System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)),sigptr + let bytearray, sigptr = sigptrGetBytes n bytes sigptr + (System.Text.Encoding.UTF8.GetString(bytearray, 0, bytearray.Length)), sigptr // -------------------------------------------------------------------- @@ -437,7 +437,7 @@ let volatileOrUnalignedPrefix mk prefixes = if prefixes.tl <> Normalcall then failwith "a tailcall prefix is not allowed here" if prefixes.constrained <> None then failwith "a constrained prefix is not allowed here" if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" - mk (prefixes.al,prefixes.vol) + mk (prefixes.al, prefixes.vol) let volatilePrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" @@ -457,7 +457,7 @@ let constraintOrTailPrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" if prefixes.vol <> Nonvolatile then failwith "a volatile prefix is not allowed here" if prefixes.ro <> NormalAddress then failwith "a readonly prefix is not allowed here" - mk (prefixes.constrained,prefixes.tl ) + mk (prefixes.constrained, prefixes.tl ) let readonlyPrefix mk prefixes = if prefixes.al <> Aligned then failwith "an unaligned prefix is not allowed here" @@ -490,40 +490,40 @@ type ILInstrDecoder = | I_type_instr of (ILInstrPrefixesRegister -> ILType -> ILInstr) | I_invalid_instr -let mkStind dt = volatileOrUnalignedPrefix (fun (x,y) -> I_stind(x,y,dt)) -let mkLdind dt = volatileOrUnalignedPrefix (fun (x,y) -> I_ldind(x,y,dt)) +let mkStind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_stind(x, y, dt)) +let mkLdind dt = volatileOrUnalignedPrefix (fun (x, y) -> I_ldind(x, y, dt)) let instrs () = - [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg) - i_starg_s, I_u16_u8_instr (noPrefixes I_starg) - i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga) - i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc) - i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc) - i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca) - i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg) - i_starg, I_u16_u16_instr (noPrefixes I_starg) - i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga) - i_stloc, I_u16_u16_instr (noPrefixes mkStloc) - i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc) - i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca) - i_stind_i, I_none_instr (mkStind DT_I) - i_stind_i1, I_none_instr (mkStind DT_I1) - i_stind_i2, I_none_instr (mkStind DT_I2) - i_stind_i4, I_none_instr (mkStind DT_I4) - i_stind_i8, I_none_instr (mkStind DT_I8) - i_stind_r4, I_none_instr (mkStind DT_R4) - i_stind_r8, I_none_instr (mkStind DT_R8) + [ i_ldarg_s, I_u16_u8_instr (noPrefixes mkLdarg) + i_starg_s, I_u16_u8_instr (noPrefixes I_starg) + i_ldarga_s, I_u16_u8_instr (noPrefixes I_ldarga) + i_stloc_s, I_u16_u8_instr (noPrefixes mkStloc) + i_ldloc_s, I_u16_u8_instr (noPrefixes mkLdloc) + i_ldloca_s, I_u16_u8_instr (noPrefixes I_ldloca) + i_ldarg, I_u16_u16_instr (noPrefixes mkLdarg) + i_starg, I_u16_u16_instr (noPrefixes I_starg) + i_ldarga, I_u16_u16_instr (noPrefixes I_ldarga) + i_stloc, I_u16_u16_instr (noPrefixes mkStloc) + i_ldloc, I_u16_u16_instr (noPrefixes mkLdloc) + i_ldloca, I_u16_u16_instr (noPrefixes I_ldloca) + i_stind_i, I_none_instr (mkStind DT_I) + i_stind_i1, I_none_instr (mkStind DT_I1) + i_stind_i2, I_none_instr (mkStind DT_I2) + i_stind_i4, I_none_instr (mkStind DT_I4) + i_stind_i8, I_none_instr (mkStind DT_I8) + i_stind_r4, I_none_instr (mkStind DT_R4) + i_stind_r8, I_none_instr (mkStind DT_R8) i_stind_ref, I_none_instr (mkStind DT_REF) - i_ldind_i, I_none_instr (mkLdind DT_I) - i_ldind_i1, I_none_instr (mkLdind DT_I1) - i_ldind_i2, I_none_instr (mkLdind DT_I2) - i_ldind_i4, I_none_instr (mkLdind DT_I4) - i_ldind_i8, I_none_instr (mkLdind DT_I8) - i_ldind_u1, I_none_instr (mkLdind DT_U1) - i_ldind_u2, I_none_instr (mkLdind DT_U2) - i_ldind_u4, I_none_instr (mkLdind DT_U4) - i_ldind_r4, I_none_instr (mkLdind DT_R4) - i_ldind_r8, I_none_instr (mkLdind DT_R8) + i_ldind_i, I_none_instr (mkLdind DT_I) + i_ldind_i1, I_none_instr (mkLdind DT_I1) + i_ldind_i2, I_none_instr (mkLdind DT_I2) + i_ldind_i4, I_none_instr (mkLdind DT_I4) + i_ldind_i8, I_none_instr (mkLdind DT_I8) + i_ldind_u1, I_none_instr (mkLdind DT_U1) + i_ldind_u2, I_none_instr (mkLdind DT_U2) + i_ldind_u4, I_none_instr (mkLdind DT_U4) + i_ldind_r4, I_none_instr (mkLdind DT_R4) + i_ldind_r8, I_none_instr (mkLdind DT_R8) i_ldind_ref, I_none_instr (mkLdind DT_REF) i_cpblk, I_none_instr (volatileOrUnalignedPrefix I_cpblk) i_initblk, I_none_instr (volatileOrUnalignedPrefix I_initblk) @@ -532,62 +532,62 @@ let instrs () = i_ldc_i4_s, I_i32_i8_instr (noPrefixes mkLdcInt32) i_ldc_r4, I_r4_instr (noPrefixes (fun x -> (AI_ldc (DT_R4, ILConst.R4 x)))) i_ldc_r8, I_r8_instr (noPrefixes (fun x -> (AI_ldc (DT_R8, ILConst.R8 x)))) - i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_ldfld(x,y,fspec))) - i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x,y) fspec -> I_stfld(x,y,fspec))) + i_ldfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_ldfld(x, y, fspec))) + i_stfld, I_field_instr (volatileOrUnalignedPrefix(fun (x, y) fspec -> I_stfld(x, y, fspec))) i_ldsfld, I_field_instr (volatilePrefix (fun x fspec -> I_ldsfld (x, fspec))) i_stsfld, I_field_instr (volatilePrefix (fun x fspec -> I_stsfld (x, fspec))) i_ldflda, I_field_instr (noPrefixes I_ldflda) i_ldsflda, I_field_instr (noPrefixes I_ldsflda) - i_call, I_method_instr (tailPrefix (fun tl (mspec,y) -> I_call (tl,mspec,y))) - i_ldftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldftn mspec)) - i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec,_y) -> I_ldvirtftn mspec)) + i_call, I_method_instr (tailPrefix (fun tl (mspec, y) -> I_call (tl, mspec, y))) + i_ldftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldftn mspec)) + i_ldvirtftn, I_method_instr (noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec)) i_newobj, I_method_instr (noPrefixes I_newobj) - i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c,tl) (mspec,y) -> match c with Some ty -> I_callconstraint(tl,ty,mspec,y) | None -> I_callvirt (tl,mspec,y))) + i_callvirt, I_method_instr (constraintOrTailPrefix (fun (c, tl) (mspec, y) -> match c with Some ty -> I_callconstraint(tl, ty, mspec, y) | None -> I_callvirt (tl, mspec, y))) i_leave_s, I_unconditional_i8_instr (noPrefixes (fun x -> I_leave x)) i_br_s, I_unconditional_i8_instr (noPrefixes I_br) i_leave, I_unconditional_i32_instr (noPrefixes (fun x -> I_leave x)) i_br, I_unconditional_i32_instr (noPrefixes I_br) - i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) - i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) - i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) - i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) - i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) - i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) - i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) - i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) - i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) - i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) - i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) - i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) - i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue,x))) - i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse,x))) - i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq,x))) - i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt,x))) - i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un,x))) - i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble,x))) - i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un,x))) - i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt,x))) - i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un,x))) - i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge,x))) - i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un,x))) - i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un,x))) + i_brtrue_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x))) + i_brfalse_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x))) + i_beq_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x))) + i_blt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x))) + i_blt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x))) + i_ble_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x))) + i_ble_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x))) + i_bgt_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x))) + i_bgt_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x))) + i_bge_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x))) + i_bge_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x))) + i_bne_un_s, I_conditional_i8_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x))) + i_brtrue, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brtrue, x))) + i_brfalse, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_brfalse, x))) + i_beq, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_beq, x))) + i_blt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt, x))) + i_blt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_blt_un, x))) + i_ble, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble, x))) + i_ble_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_ble_un, x))) + i_bgt, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt, x))) + i_bgt_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bgt_un, x))) + i_bge, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge, x))) + i_bge_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bge_un, x))) + i_bne_un, I_conditional_i32_instr (noPrefixes (fun x -> I_brcmp (BI_bne_un, x))) i_ldstr, I_string_instr (noPrefixes I_ldstr) i_switch, I_switch_instr (noPrefixes I_switch) i_ldtoken, I_tok_instr (noPrefixes I_ldtoken) - i_calli, I_sig_instr (tailPrefix (fun tl (x,y) -> I_calli (tl, x, y))) + i_calli, I_sig_instr (tailPrefix (fun tl (x, y) -> I_calli (tl, x, y))) i_mkrefany, I_type_instr (noPrefixes I_mkrefany) i_refanyval, I_type_instr (noPrefixes I_refanyval) - i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro,false,ILArrayShape.SingleDimensional,x))) - i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x))) - i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional,x))) - i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional,x))) + i_ldelema, I_type_instr (readonlyPrefix (fun ro x -> I_ldelema (ro, false, ILArrayShape.SingleDimensional, x))) + i_ldelem_any, I_type_instr (noPrefixes (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional, x))) + i_stelem_any, I_type_instr (noPrefixes (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x))) + i_newarr, I_type_instr (noPrefixes (fun x -> I_newarr (ILArrayShape.SingleDimensional, x))) i_castclass, I_type_instr (noPrefixes I_castclass) i_isinst, I_type_instr (noPrefixes I_isinst) i_unbox_any, I_type_instr (noPrefixes I_unbox_any) i_cpobj, I_type_instr (noPrefixes I_cpobj) i_initobj, I_type_instr (noPrefixes I_initobj) - i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_ldobj (x,y,z))) - i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x,y) z -> I_stobj (x,y,z))) + i_ldobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_ldobj (x, y, z))) + i_stobj, I_type_instr (volatileOrUnalignedPrefix (fun (x, y) z -> I_stobj (x, y, z))) i_sizeof, I_type_instr (noPrefixes I_sizeof) i_box, I_type_instr (noPrefixes I_box) i_unbox, I_type_instr (noPrefixes I_unbox) ] @@ -599,7 +599,7 @@ let twoByteInstrs = ref None let fillInstrs () = let oneByteInstrTable = Array.create 256 I_invalid_instr let twoByteInstrTable = Array.create 256 I_invalid_instr - let addInstr (i,f) = + let addInstr (i, f) = if i > 0xff then assert (i >>>& 8 = 0xfe) let i = (i &&& 0xff) @@ -613,7 +613,7 @@ let fillInstrs () = | _ -> dprintn ("warning: duplicate decode entries for "+string i) oneByteInstrTable.[i] <- f List.iter addInstr (instrs()) - List.iter (fun (x,mk) -> addInstr (x,I_none_instr (noPrefixes mk))) (noArgInstrs.Force()) + List.iter (fun (x, mk) -> addInstr (x, I_none_instr (noPrefixes mk))) (noArgInstrs.Force()) oneByteInstrs := Some oneByteInstrTable twoByteInstrs := Some twoByteInstrTable @@ -633,8 +633,8 @@ let rec getTwoByteInstr i = type ImageChunk = { size: int32; addr: int32 } -let chunk sz next = ({addr=next; size=sz},next + sz) -let nochunk next = ({addr= 0x0;size= 0x0; } ,next) +let chunk sz next = ({addr=next; size=sz}, next + sz) +let nochunk next = ({addr= 0x0;size= 0x0; } , next) type RowElementKind = | UShort @@ -761,7 +761,7 @@ let mkCacheInt32 lowMem _inbase _nm _sz = fun f (idx:int32) -> let cache = match !cache with - | null -> cache := new Dictionary(11) + | null -> cache := new Dictionary(11) | _ -> () !cache let mutable res = Unchecked.defaultof<_> @@ -784,7 +784,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz = fun f (idx :'T) -> let cache = match !cache with - | null -> cache := new Dictionary<_,_>(11 (* sz:int *) ) + | null -> cache := new Dictionary<_, _>(11 (* sz:int *) ) | _ -> () !cache if cache.ContainsKey idx then (incr count; cache.[idx]) @@ -1090,7 +1090,7 @@ let seekReadTypeRefRow ctxt idx = let scopeIdx = seekReadResolutionScopeIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let namespaceIdx = seekReadStringIdx ctxt &addr - (scopeIdx,nameIdx,namespaceIdx) + (scopeIdx, nameIdx, namespaceIdx) /// Read Table ILTypeDef. let seekReadTypeDefRow ctxt idx = ctxt.seekReadTypeDefRow idx @@ -1113,7 +1113,7 @@ let seekReadFieldRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typeIdx = seekReadBlobIdx ctxt &addr - (flags,nameIdx,typeIdx) + (flags, nameIdx, typeIdx) /// Read Table Method. let seekReadMethodRow ctxt idx = @@ -1134,7 +1134,7 @@ let seekReadParamRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let seq = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr - (flags,seq,nameIdx) + (flags, seq, nameIdx) /// Read Table InterfaceImpl. let seekReadInterfaceImplRow ctxt idx = ctxt.seekReadInterfaceImplRow idx @@ -1144,7 +1144,7 @@ let seekReadInterfaceImplRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let intfIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (tidx,intfIdx) + (tidx, intfIdx) /// Read Table MemberRef. let seekReadMemberRefRow ctxt idx = @@ -1153,7 +1153,7 @@ let seekReadMemberRefRow ctxt idx = let mrpIdx = seekReadMemberRefParentIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typeIdx = seekReadBlobIdx ctxt &addr - (mrpIdx,nameIdx,typeIdx) + (mrpIdx, nameIdx, typeIdx) /// Read Table Constant. let seekReadConstantRow ctxt idx = ctxt.seekReadConstantRow idx @@ -1201,7 +1201,7 @@ let seekReadClassLayoutRow ctxt idx = let pack = seekReadUInt16Adv ctxt &addr let size = seekReadInt32Adv ctxt &addr let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr - (pack,size,tidx) + (pack, size, tidx) /// Read Table FieldLayout. let seekReadFieldLayoutRow ctxt idx = @@ -1209,7 +1209,7 @@ let seekReadFieldLayoutRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.FieldLayout idx let offset = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr - (offset,fidx) + (offset, fidx) //// Read Table StandAloneSig. let seekReadStandAloneSigRow ctxt idx = @@ -1224,7 +1224,7 @@ let seekReadEventMapRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.EventMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let eventsIdx = seekReadUntaggedIdx TableNames.Event ctxt &addr - (tidx,eventsIdx) + (tidx, eventsIdx) /// Read Table Event. let seekReadEventRow ctxt idx = @@ -1233,7 +1233,7 @@ let seekReadEventRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (flags,nameIdx,typIdx) + (flags, nameIdx, typIdx) /// Read Table PropertyMap. let seekReadPropertyMapRow ctxt idx = ctxt.seekReadPropertyMapRow idx @@ -1243,7 +1243,7 @@ let seekReadPropertyMapRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.PropertyMap idx let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let propsIdx = seekReadUntaggedIdx TableNames.Property ctxt &addr - (tidx,propsIdx) + (tidx, propsIdx) /// Read Table Property. let seekReadPropertyRow ctxt idx = @@ -1252,7 +1252,7 @@ let seekReadPropertyRow ctxt idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let typIdx = seekReadBlobIdx ctxt &addr - (flags,nameIdx,typIdx) + (flags, nameIdx, typIdx) /// Read Table MethodSemantics. let seekReadMethodSemanticsRow ctxt idx = ctxt.seekReadMethodSemanticsRow idx @@ -1263,7 +1263,7 @@ let seekReadMethodSemanticsRowUncached ctxtH idx = let flags = seekReadUInt16AsInt32Adv ctxt &addr let midx = seekReadUntaggedIdx TableNames.Method ctxt &addr let assocIdx = seekReadHasSemanticsIdx ctxt &addr - (flags,midx,assocIdx) + (flags, midx, assocIdx) /// Read Table MethodImpl. let seekReadMethodImplRow ctxt idx = @@ -1272,7 +1272,7 @@ let seekReadMethodImplRow ctxt idx = let tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let mbodyIdx = seekReadMethodDefOrRefIdx ctxt &addr let mdeclIdx = seekReadMethodDefOrRefIdx ctxt &addr - (tidx,mbodyIdx,mdeclIdx) + (tidx, mbodyIdx, mdeclIdx) /// Read Table ILModuleRef. let seekReadModuleRefRow ctxt idx = @@ -1304,7 +1304,7 @@ let seekReadFieldRVARow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.FieldRVA idx let rva = seekReadInt32Adv ctxt &addr let fidx = seekReadUntaggedIdx TableNames.Field ctxt &addr - (rva,fidx) + (rva, fidx) /// Read Table Assembly. let seekReadAssemblyRow ctxt idx = @@ -1319,7 +1319,7 @@ let seekReadAssemblyRow ctxt idx = let publicKeyIdx = seekReadBlobIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let localeIdx = seekReadStringIdx ctxt &addr - (hash,v1,v2,v3,v4,flags,publicKeyIdx, nameIdx, localeIdx) + (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) /// Read Table ILAssemblyRef. let seekReadAssemblyRefRow ctxt idx = @@ -1334,7 +1334,7 @@ let seekReadAssemblyRefRow ctxt idx = let nameIdx = seekReadStringIdx ctxt &addr let localeIdx = seekReadStringIdx ctxt &addr let hashValueIdx = seekReadBlobIdx ctxt &addr - (v1,v2,v3,v4,flags,publicKeyOrTokenIdx, nameIdx, localeIdx,hashValueIdx) + (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) /// Read Table File. let seekReadFileRow ctxt idx = @@ -1354,7 +1354,7 @@ let seekReadExportedTypeRow ctxt idx = let nameIdx = seekReadStringIdx ctxt &addr let namespaceIdx = seekReadStringIdx ctxt &addr let implIdx = seekReadImplementationIdx ctxt &addr - (flags,tok,nameIdx,namespaceIdx,implIdx) + (flags, tok, nameIdx, namespaceIdx, implIdx) /// Read Table ManifestResource. let seekReadManifestResourceRow ctxt idx = @@ -1364,7 +1364,7 @@ let seekReadManifestResourceRow ctxt idx = let flags = seekReadInt32Adv ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr let implIdx = seekReadImplementationIdx ctxt &addr - (offset,flags,nameIdx,implIdx) + (offset, flags, nameIdx, implIdx) /// Read Table Nested. let seekReadNestedRow ctxt idx = ctxt.seekReadNestedRow idx @@ -1374,7 +1374,7 @@ let seekReadNestedRowUncached ctxtH idx = let mutable addr = ctxt.rowAddr TableNames.Nested idx let nestedIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr let enclIdx = seekReadUntaggedIdx TableNames.TypeDef ctxt &addr - (nestedIdx,enclIdx) + (nestedIdx, enclIdx) /// Read Table GenericParam. let seekReadGenericParamRow ctxt idx = @@ -1384,7 +1384,7 @@ let seekReadGenericParamRow ctxt idx = let flags = seekReadUInt16Adv ctxt &addr let ownerIdx = seekReadTypeOrMethodDefIdx ctxt &addr let nameIdx = seekReadStringIdx ctxt &addr - (idx,seq,flags,ownerIdx,nameIdx) + (idx, seq, flags, ownerIdx, nameIdx) // Read Table GenericParamConstraint. let seekReadGenericParamConstraintRow ctxt idx = @@ -1392,7 +1392,7 @@ let seekReadGenericParamConstraintRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.GenericParamConstraint idx let pidx = seekReadUntaggedIdx TableNames.GenericParam ctxt &addr let constraintIdx = seekReadTypeDefOrRefOrSpecIdx ctxt &addr - (pidx,constraintIdx) + (pidx, constraintIdx) /// Read Table ILMethodSpec. let seekReadMethodSpecRow ctxt idx = @@ -1400,7 +1400,7 @@ let seekReadMethodSpecRow ctxt idx = let mutable addr = ctxt.rowAddr TableNames.MethodSpec idx let mdorIdx = seekReadMethodDefOrRefIdx ctxt &addr let instIdx = seekReadBlobIdx ctxt &addr - (mdorIdx,instIdx) + (mdorIdx, instIdx) let readUserStringHeapUncached ctxtH idx = @@ -1465,7 +1465,7 @@ let readNativeResources ctxt = if ctxt.nativeResourcesSize = 0x0 || ctxt.nativeResourcesAddr = 0x0 then [] else - [ (lazy (let linkedResource = seekReadBytes ctxt.is (ctxt.anyV2P (ctxt.infile + ": native resources",ctxt.nativeResourcesAddr)) ctxt.nativeResourcesSize + [ (lazy (let linkedResource = seekReadBytes ctxt.is (ctxt.anyV2P (ctxt.infile + ": native resources", ctxt.nativeResourcesAddr)) ctxt.nativeResourcesSize unlinkResource ctxt.nativeResourcesAddr linkedResource)) ] nativeResources #endif @@ -1476,10 +1476,10 @@ let dataEndPoints ctxtH = let dataStartPoints = let res = ref [] for i = 1 to ctxt.getNumRows (TableNames.FieldRVA) do - let rva,_fidx = seekReadFieldRVARow ctxt i - res := ("field",rva) :: !res + let rva, _fidx = seekReadFieldRVARow ctxt i + res := ("field", rva) :: !res for i = 1 to ctxt.getNumRows TableNames.ManifestResource do - let (offset,_,_,TaggedIndex(_tag,idx)) = seekReadManifestResourceRow ctxt i + let (offset, _, _, TaggedIndex(_tag, idx)) = seekReadManifestResourceRow ctxt i if idx = 0 then let rva = ctxt.resourcesAddr + offset res := ("manifest resource", rva) :: !res @@ -1492,19 +1492,19 @@ let dataEndPoints ctxtH = let (rva, _, _, nameIdx, _, _) = seekReadMethodRow ctxt i if rva <> 0 then let nm = readStringHeap ctxt nameIdx - res := (nm,rva) :: !res + res := (nm, rva) :: !res !res ([ ctxt.textSegmentPhysicalLoc + ctxt.textSegmentPhysicalSize ; ctxt.dataSegmentPhysicalLoc + ctxt.dataSegmentPhysicalSize ] @ (List.map ctxt.anyV2P (dataStartPoints - @ [for (virtAddr,_virtSize,_physLoc) in ctxt.sectionHeaders do yield ("section start",virtAddr) done] - @ [("md",ctxt.metadataAddr)] - @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources",ctxt.nativeResourcesAddr) ]) - @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources",ctxt.resourcesAddr) ]) - @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname",ctxt.strongnameAddr) ]) - @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups",ctxt.vtableFixupsAddr) ]) + @ [for (virtAddr, _virtSize, _physLoc) in ctxt.sectionHeaders do yield ("section start", virtAddr) done] + @ [("md", ctxt.metadataAddr)] + @ (if ctxt.nativeResourcesAddr = 0x0 then [] else [("native resources", ctxt.nativeResourcesAddr) ]) + @ (if ctxt.resourcesAddr = 0x0 then [] else [("managed resources", ctxt.resourcesAddr) ]) + @ (if ctxt.strongnameAddr = 0x0 then [] else [("managed strongname", ctxt.strongnameAddr) ]) + @ (if ctxt.vtableFixupsAddr = 0x0 then [] else [("managed vtable_fixups", ctxt.vtableFixupsAddr) ]) @ methodRVAs))) |> List.distinct |> List.sort @@ -1532,7 +1532,7 @@ let rec rvaToData ctxt nm rva = let isSorted ctxt (tab:TableName) = ((ctxt.sorted &&& (int64 1 <<< tab.Index)) <> int64 0x0) -let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only32,is32bitpreferred,only64,platform,isDll, alignVirt,alignPhys,imageBaseReal,ilMetadataVersion) idx = +let rec seekReadModule ctxt (subsys, subsysversion, useHighEntropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal, ilMetadataVersion) idx = let (_generation, nameIdx, _mvidIdx, _encidIdx, _encbaseidIdx) = seekReadModuleRow ctxt idx let ilModuleName = readStringHeap ctxt nameIdx let nativeResources = readNativeResources ctxt @@ -1540,7 +1540,7 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3 { Manifest = if ctxt.getNumRows (TableNames.Assembly) > 0 then Some (seekReadAssemblyManifest ctxt 1) else None - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module,idx)) + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module, idx)) Name = ilModuleName NativeResources=nativeResources TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt ()) @@ -1561,16 +1561,16 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3 Resources = seekReadManifestResources ctxt () } and seekReadAssemblyManifest ctxt idx = - let (hash,v1,v2,v3,v4,flags,publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt idx + let (hash, v1, v2, v3, v4, flags, publicKeyIdx, nameIdx, localeIdx) = seekReadAssemblyRow ctxt idx let name = readStringHeap ctxt nameIdx let pubkey = readBlobHeapOption ctxt publicKeyIdx { Name= name AuxModuleHashAlgorithm=hash - SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly,idx)) + SecurityDecls= seekReadSecurityDecls ctxt (TaggedIndex(hds_Assembly, idx)) PublicKey= pubkey - Version= Some (v1,v2,v3,v4) + Version= Some (v1, v2, v3, v4) Locale= readStringHeapOption ctxt localeIdx - CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly,idx)) + CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Assembly, idx)) AssemblyLongevity= begin let masked = flags &&& 0x000e if masked = 0x0000 then ILAssemblyLongevity.Unspecified @@ -1590,7 +1590,7 @@ and seekReadAssemblyManifest ctxt idx = and seekReadAssemblyRef ctxt idx = ctxt.seekReadAssemblyRef idx and seekReadAssemblyRefUncached ctxtH idx = let ctxt = getHole ctxtH - let (v1,v2,v3,v4,flags,publicKeyOrTokenIdx, nameIdx, localeIdx,hashValueIdx) = seekReadAssemblyRefRow ctxt idx + let (v1, v2, v3, v4, flags, publicKeyOrTokenIdx, nameIdx, localeIdx, hashValueIdx) = seekReadAssemblyRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let publicKey = match readBlobHeapOption ctxt publicKeyOrTokenIdx with @@ -1600,27 +1600,27 @@ and seekReadAssemblyRefUncached ctxtH idx = ILAssemblyRef.Create (name=nm, hash=readBlobHeapOption ctxt hashValueIdx, - publicKey=publicKey, + publicKey=publicKey, retargetable=((flags &&& 0x0100) <> 0x0), - version=Some(v1,v2,v3,v4), + version=Some(v1, v2, v3, v4), locale=readStringHeapOption ctxt localeIdx) and seekReadModuleRef ctxt idx = let (nameIdx) = seekReadModuleRefRow ctxt idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, - hasMetadata=true, + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, + hasMetadata=true, hash=None) and seekReadFile ctxt idx = let (flags, nameIdx, hashValueIdx) = seekReadFileRow ctxt idx - ILModuleRef.Create(name = readStringHeap ctxt nameIdx, - hasMetadata= ((flags &&& 0x0001) = 0x0), + ILModuleRef.Create(name = readStringHeap ctxt nameIdx, + hasMetadata= ((flags &&& 0x0001) = 0x0), hash= readBlobHeapOption ctxt hashValueIdx) and seekReadClassLayout ctxt idx = - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout,seekReadClassLayoutRow ctxt,(fun (_,_,tidx) -> tidx),simpleIndexCompare idx,isSorted ctxt TableNames.ClassLayout,(fun (pack,size,_) -> pack,size)) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.ClassLayout, seekReadClassLayoutRow ctxt, (fun (_, _, tidx) -> tidx), simpleIndexCompare idx, isSorted ctxt TableNames.ClassLayout, (fun (pack, size, _) -> pack, size)) with | None -> { Size = None; Pack = None } - | Some (pack,size) -> { Size = Some size; Pack = Some pack } + | Some (pack, size) -> { Size = Some size; Pack = Some pack } and memberAccessOfFlags flags = let f = (flags &&& 0x00000007) @@ -1673,17 +1673,17 @@ and isTopTypeDef flags = typeAccessOfFlags flags = ILTypeDefAccess.Public and seekIsTopTypeDefOfIdx ctxt idx = - let (flags,_,_, _, _,_) = seekReadTypeDefRow ctxt idx + let (flags, _, _, _, _, _) = seekReadTypeDefRow ctxt idx isTopTypeDef flags -and readBlobHeapAsSplitTypeName ctxt (nameIdx,namespaceIdx) = +and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) = let name = readStringHeap ctxt nameIdx let nspace = readStringHeapOption ctxt namespaceIdx match nspace with - | Some nspace -> splitNamespace nspace,name - | None -> [],name + | Some nspace -> splitNamespace nspace, name + | None -> [], name -and readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) = +and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = let name = readStringHeap ctxt nameIdx let nspace = readStringHeapOption ctxt namespaceIdx match nspace with @@ -1692,7 +1692,7 @@ and readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) = and seekReadTypeDefRowExtents ctxt _info (idx:int) = if idx >= ctxt.getNumRows TableNames.TypeDef then - ctxt.getNumRows TableNames.Field + 1, + ctxt.getNumRows TableNames.Field + 1, ctxt.getNumRows TableNames.Method + 1 else let (_, _, _, _, fieldsIdx, methodsIdx) = seekReadTypeDefRow ctxt (idx + 1) @@ -1700,35 +1700,35 @@ and seekReadTypeDefRowExtents ctxt _info (idx:int) = and seekReadTypeDefRowWithExtents ctxt (idx:int) = let info= seekReadTypeDefRow ctxt idx - info,seekReadTypeDefRowExtents ctxt info idx + info, seekReadTypeDefRowExtents ctxt info idx and seekReadTypeDef ctxt toponly (idx:int) = - let (flags,nameIdx,namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx + let (flags, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx if toponly && not (isTopTypeDef flags) then None else - let ns,n = readBlobHeapAsSplitTypeName ctxt (nameIdx,namespaceIdx) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef,idx)) + let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef, idx)) let rest = lazy // Re-read so as not to save all these in the lazy closure - this suspension ctxt.is the largest // heavily allocated one in all of AbsIL - let ((flags,nameIdx,namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef,idx)) + let ((flags, nameIdx, namespaceIdx, extendsIdx, fieldsIdx, methodsIdx) as info) = seekReadTypeDefRow ctxt idx + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_TypeDef, idx)) let (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx - let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef,idx) + let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx) let numtypars = typars.Length let super = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject extendsIdx let layout = typeLayoutOfFlags ctxt flags idx let hasLayout = (match layout with ILTypeDefLayout.Explicit _ -> true | _ -> false) let mdefs = seekReadMethods ctxt numtypars methodsIdx endMethodsIdx - let fdefs = seekReadFields ctxt (numtypars,hasLayout) fieldsIdx endFieldsIdx + let fdefs = seekReadFields ctxt (numtypars, hasLayout) fieldsIdx endFieldsIdx let kind = typeKindOfFlags nm mdefs fdefs super flags let nested = seekReadNestedTypeDefs ctxt idx let impls = seekReadInterfaceImpls ctxt numtypars idx - let sdecls = seekReadSecurityDecls ctxt (TaggedIndex(hds_TypeDef,idx)) + let sdecls = seekReadSecurityDecls ctxt (TaggedIndex(hds_TypeDef, idx)) let mimpls = seekReadMethodImpls ctxt numtypars idx let props = seekReadProperties ctxt numtypars idx let events = seekReadEvents ctxt numtypars idx @@ -1758,7 +1758,7 @@ and seekReadTypeDef ctxt toponly (idx:int) = Events= events Properties=props CustomAttrs=cas } - Some (ns,n,cas,rest) + Some (ns, n, cas, rest) and seekReadTopTypeDefs ctxt () = [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do @@ -1768,32 +1768,32 @@ and seekReadTopTypeDefs ctxt () = and seekReadNestedTypeDefs ctxt tidx = mkILTypeDefsComputed (fun () -> - let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested,seekReadNestedRow ctxt,snd,simpleIndexCompare tidx,false,fst) + let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst) [| for i in nestedIdxs do match seekReadTypeDef ctxt false i with | None -> () | Some td -> yield td |]) and seekReadInterfaceImpls ctxt numtypars tidx = - seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, - seekReadInterfaceImplRow ctxt, - fst, - simpleIndexCompare tidx, - isSorted ctxt TableNames.InterfaceImpl, + seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl, + seekReadInterfaceImplRow ctxt, + fst, + simpleIndexCompare tidx, + isSorted ctxt TableNames.InterfaceImpl, (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) -and seekReadGenericParams ctxt numtypars (a,b) : ILGenericParameterDefs = - ctxt.seekReadGenericParams (GenericParamsIdx(numtypars,a,b)) +and seekReadGenericParams ctxt numtypars (a, b) : ILGenericParameterDefs = + ctxt.seekReadGenericParams (GenericParamsIdx(numtypars, a, b)) -and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = +and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars, a, b)) = let ctxt = getHole ctxtH let pars = seekReadIndexedRows - (ctxt.getNumRows TableNames.GenericParam,seekReadGenericParamRow ctxt, - (fun (_,_,_,tomd,_) -> tomd), - tomdCompare (TaggedIndex(a,b)), - isSorted ctxt TableNames.GenericParam, - (fun (gpidx,seq,flags,_,nameIdx) -> + (ctxt.getNumRows TableNames.GenericParam, seekReadGenericParamRow ctxt, + (fun (_, _, _, tomd, _) -> tomd), + tomdCompare (TaggedIndex(a, b)), + isSorted ctxt TableNames.GenericParam, + (fun (gpidx, seq, flags, _, nameIdx) -> let flags = int32 flags let variance_flags = flags &&& 0x0003 let variance = @@ -1802,7 +1802,7 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = elif variance_flags = 0x0002 then ContraVariant else NonVariant let constraints = seekReadGenericParamConstraintsUncached ctxt numtypars gpidx - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_GenericParam,gpidx)) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_GenericParam, gpidx)) seq, {Name=readStringHeap ctxt nameIdx Constraints = constraints Variance=variance @@ -1814,17 +1814,17 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numtypars,a,b)) = and seekReadGenericParamConstraintsUncached ctxt numtypars gpidx = seekReadIndexedRows - (ctxt.getNumRows TableNames.GenericParamConstraint, - seekReadGenericParamConstraintRow ctxt, - fst, - simpleIndexCompare gpidx, - isSorted ctxt TableNames.GenericParamConstraint, + (ctxt.getNumRows TableNames.GenericParamConstraint, + seekReadGenericParamConstraintRow ctxt, + fst, + simpleIndexCompare gpidx, + isSorted ctxt TableNames.GenericParamConstraint, (snd >> seekReadTypeDefOrRef ctxt numtypars AsObject (*ok*) List.empty)) and seekReadTypeDefAsType ctxt boxity (ginst:ILTypes) idx = - ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity,ginst,idx)) + ctxt.seekReadTypeDefAsType (TypeDefAsTypIdx (boxity, ginst, idx)) -and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity,ginst,idx)) = +and seekReadTypeDefAsTypeUncached ctxtH (TypeDefAsTypIdx (boxity, ginst, idx)) = let ctxt = getHole ctxtH mkILTy boxity (ILTypeSpec.Create(seekReadTypeDefAsTypeRef ctxt idx, ginst)) @@ -1832,27 +1832,27 @@ and seekReadTypeDefAsTypeRef ctxt idx = let enc = if seekIsTopTypeDefOfIdx ctxt idx then [] else - let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested,seekReadNestedRow ctxt,fst,simpleIndexCompare idx,isSorted ctxt TableNames.Nested,snd) + let enclIdx = seekReadIndexedRow (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, fst, simpleIndexCompare idx, isSorted ctxt TableNames.Nested, snd) let tref = seekReadTypeDefAsTypeRef ctxt enclIdx tref.Enclosing@[tref.Name] let (_, nameIdx, namespaceIdx, _, _, _) = seekReadTypeDefRow ctxt idx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=ILScopeRef.Local, enclosing=enc, name = nm ) and seekReadTypeRef ctxt idx = ctxt.seekReadTypeRef idx and seekReadTypeRefUncached ctxtH idx = let ctxt = getHole ctxtH - let scopeIdx,nameIdx,namespaceIdx = seekReadTypeRefRow ctxt idx - let scope,enc = seekReadTypeRefScope ctxt scopeIdx - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt idx + let scope, enc = seekReadTypeRefScope ctxt scopeIdx + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) ILTypeRef.Create(scope=scope, enclosing=enc, name = nm) -and seekReadTypeRefAsType ctxt boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity,ginst,idx)) -and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity,ginst,idx)) = +and seekReadTypeRefAsType ctxt boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx (boxity, ginst, idx)) +and seekReadTypeRefAsTypeUncached ctxtH (TypeRefAsTypIdx (boxity, ginst, idx)) = let ctxt = getHole ctxtH mkILTy boxity (ILTypeSpec.Create(seekReadTypeRef ctxt idx, ginst)) -and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag,idx) ) = +and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, idx) ) = match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsType ctxt boxity ginst idx | tag when tag = tdor_TypeRef -> seekReadTypeRefAsType ctxt boxity ginst idx @@ -1861,7 +1861,7 @@ and seekReadTypeDefOrRef ctxt numtypars boxity (ginst:ILTypes) (TaggedIndex(tag, readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt idx) | _ -> failwith "seekReadTypeDefOrRef ctxt" -and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = +and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag, idx) ) = match tag with | tag when tag = tdor_TypeDef -> seekReadTypeDefAsTypeRef ctxt idx | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx @@ -1870,7 +1870,7 @@ and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = ctxt.ilg.typ_Object.TypeRef | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" -and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag,idx)) = +and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag, idx)) = match tag with | tag when tag = mrp_TypeRef -> seekReadTypeRefAsType ctxt AsObject (* not ok - no way to tell if a member ref parent ctxt.is a value type or not *) List.empty idx | tag when tag = mrp_ModuleRef -> mkILTypeForGlobalFunctions (ILScopeRef.Module (seekReadModuleRef ctxt idx)) @@ -1881,11 +1881,11 @@ and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag,idx)) = | tag when tag = mrp_TypeSpec -> readBlobHeapAsType ctxt numtypars (seekReadTypeSpecRow ctxt idx) | _ -> failwith "seekReadMethodRefParent ctxt" -and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag,idx)) = +and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag, idx)) = match tag with | tag when tag = mdor_MethodDef -> - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefAsMethodData ctxt idx - VarArgMethodData(enclTyp, cc, nm, argtys, None,retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx + VarArgMethodData(enclTyp, cc, nm, argtys, None, retty, minst) | tag when tag = mdor_MemberRef -> seekReadMemberRefAsMethodData ctxt numtypars idx | _ -> failwith "seekReadMethodDefOrRef ctxt" @@ -1893,9 +1893,9 @@ and seekReadMethodDefOrRef ctxt numtypars (TaggedIndex(tag,idx)) = and seekReadMethodDefOrRefNoVarargs ctxt numtypars x = let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = seekReadMethodDefOrRef ctxt numtypars x if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" - MethodData(enclTyp, cc, nm, argtys, retty,minst) + MethodData(enclTyp, cc, nm, argtys, retty, minst) -and seekReadCustomAttrType ctxt (TaggedIndex(tag,idx) ) = +and seekReadCustomAttrType ctxt (TaggedIndex(tag, idx) ) = match tag with | tag when tag = cat_MethodDef -> let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt idx @@ -1905,7 +1905,7 @@ and seekReadCustomAttrType ctxt (TaggedIndex(tag,idx) ) = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) | _ -> failwith "seekReadCustomAttrType ctxt" -and seekReadImplAsScopeRef ctxt (TaggedIndex(tag,idx) ) = +and seekReadImplAsScopeRef ctxt (TaggedIndex(tag, idx) ) = if idx = 0 then ILScopeRef.Local else match tag with @@ -1914,14 +1914,14 @@ and seekReadImplAsScopeRef ctxt (TaggedIndex(tag,idx) ) = | tag when tag = i_ExportedType -> failwith "seekReadImplAsScopeRef ctxt" | _ -> failwith "seekReadImplAsScopeRef ctxt" -and seekReadTypeRefScope ctxt (TaggedIndex(tag,idx) ) = +and seekReadTypeRefScope ctxt (TaggedIndex(tag, idx) ) = match tag with - | tag when tag = rs_Module -> ILScopeRef.Local,[] - | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt idx),[] - | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx),[] + | tag when tag = rs_Module -> ILScopeRef.Local, [] + | tag when tag = rs_ModuleRef -> ILScopeRef.Module (seekReadModuleRef ctxt idx), [] + | tag when tag = rs_AssemblyRef -> ILScopeRef.Assembly (seekReadAssemblyRef ctxt idx), [] | tag when tag = rs_TypeRef -> let tref = seekReadTypeRef ctxt idx - tref.Scope,(tref.Enclosing@[tref.Name]) + tref.Scope, (tref.Enclosing@[tref.Name]) | _ -> failwith "seekReadTypeRefScope ctxt" and seekReadOptionalTypeDefOrRef ctxt numtypars boxity idx = @@ -1929,7 +1929,7 @@ and seekReadOptionalTypeDefOrRef ctxt numtypars boxity idx = else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx) and seekReadField ctxt (numtypars, hasLayout) (idx:int) = - let (flags,nameIdx,typeIdx) = seekReadFieldRow ctxt idx + let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt idx let nm = readStringHeap ctxt nameIdx let isStatic = (flags &&& 0x0010) <> 0 let fd = @@ -1941,24 +1941,24 @@ and seekReadField ctxt (numtypars, hasLayout) (idx:int) = IsLiteral = (flags &&& 0x0040) <> 0 NotSerialized = (flags &&& 0x0080) <> 0 IsSpecialName = (flags &&& 0x0200) <> 0 || (flags &&& 0x0400) <> 0 (* REVIEW: RTSpecialName *) - LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef,idx))) + LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx))) Marshal = if (flags &&& 0x1000) = 0 then None else - Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal,seekReadFieldMarshalRow ctxt, - fst,hfmCompare (TaggedIndex(hfm_FieldDef,idx)), - isSorted ctxt TableNames.FieldMarshal, + Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt, + fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)), + isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt))) Data = if (flags &&& 0x0100) = 0 then None else - let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA,seekReadFieldRVARow ctxt, - snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldRVA,fst) + let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA, seekReadFieldRVARow ctxt, + snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldRVA, fst) Some (rvaToData ctxt "field" rva) Offset = if hasLayout && not isStatic then - Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout,seekReadFieldLayoutRow ctxt, - snd,simpleIndexCompare idx,isSorted ctxt TableNames.FieldLayout,fst)) else None - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef,idx)) } + Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt, + snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef, idx)) } fd and seekReadFields ctxt (numtypars, hasLayout) fidx1 fidx2 = @@ -1975,12 +1975,12 @@ and seekReadMethods ctxt numtypars midx1 midx2 = and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr = let n, sigptr = sigptrGetZInt32 bytes sigptr if (n &&& 0x01) = 0x0 then (* Type Def *) - TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr + TaggedIndex(tdor_TypeDef, (n >>>& 2)), sigptr else (* Type Ref *) - TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr + TaggedIndex(tdor_TypeRef, (n >>>& 2)), sigptr and sigptrGetTy ctxt numtypars bytes sigptr = - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes sigptr if b0 = et_OBJECT then ctxt.ilg.typ_Object , sigptr elif b0 = et_STRING then ctxt.ilg.typ_String, sigptr elif b0 = et_I1 then ctxt.ilg.typ_SByte, sigptr @@ -1998,11 +1998,11 @@ and sigptrGetTy ctxt numtypars bytes sigptr = elif b0 = et_CHAR then ctxt.ilg.typ_Char, sigptr elif b0 = et_BOOLEAN then ctxt.ilg.typ_Bool, sigptr elif b0 = et_WITH then - let b0,sigptr = sigptrGetByte bytes sigptr + let b0, sigptr = sigptrGetByte bytes sigptr let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let n, sigptr = sigptrGetZInt32 bytes sigptr - let argtys,sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr - seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, + let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr + seekReadTypeDefOrRef ctxt numtypars (if b0 = et_CLASS then AsObject else AsValue) argtys tdorIdx, sigptr elif b0 = et_CLASS then @@ -2013,7 +2013,7 @@ and sigptrGetTy ctxt numtypars bytes sigptr = seekReadTypeDefOrRef ctxt numtypars AsValue List.empty tdorIdx, sigptr elif b0 = et_VAR then let n, sigptr = sigptrGetZInt32 bytes sigptr - ILType.TypeVar (uint16 n),sigptr + ILType.TypeVar (uint16 n), sigptr elif b0 = et_MVAR then let n, sigptr = sigptrGetZInt32 bytes sigptr ILType.TypeVar (uint16 (n + numtypars)), sigptr @@ -2035,31 +2035,31 @@ and sigptrGetTy ctxt numtypars bytes sigptr = let lobounds, sigptr = sigptrFold sigptrGetZInt32 numLoBounded bytes sigptr let shape = let dim i = - (if i < numLoBounded then Some (List.item i lobounds) else None), + (if i < numLoBounded then Some (List.item i lobounds) else None), (if i < numSized then Some (List.item i sizes) else None) ILArrayShape (Array.toList (Array.init rank dim)) mkILArrTy (typ, shape), sigptr elif b0 = et_VOID then ILType.Void, sigptr elif b0 = et_TYPEDBYREF then - let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef,"System.TypedReference")) + let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef, "System.TypedReference")) t, sigptr elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr ILType.Modified((b0 = et_CMOD_REQD), seekReadTypeDefOrRefAsTypeRef ctxt tdorIdx, typ), sigptr elif b0 = et_FNPTR then - let ccByte,sigptr = sigptrGetByte bytes sigptr - let generic,cc = byteAsCallConv ccByte + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte if generic then failwith "fptr sig may not be generic" - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let argtys,sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let argtys, sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr ILType.FunctionPointer { CallingConv=cc ArgTypes = argtys ReturnType=retty } - ,sigptr + , sigptr elif b0 = et_SENTINEL then failwith "varargs NYI" else ILType.Void , sigptr @@ -2067,18 +2067,18 @@ and sigptrGetVarArgTys ctxt n numtypars bytes sigptr = sigptrFold (sigptrGetTy ctxt numtypars) n bytes sigptr and sigptrGetArgTys ctxt n numtypars bytes sigptr acc = - if n <= 0 then (List.rev acc,None),sigptr + if n <= 0 then (List.rev acc, None), sigptr else - let b0,sigptr2 = sigptrGetByte bytes sigptr + let b0, sigptr2 = sigptrGetByte bytes sigptr if b0 = et_SENTINEL then - let varargs,sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2 - (List.rev acc,Some(varargs)),sigptr + let varargs, sigptr = sigptrGetVarArgTys ctxt n numtypars bytes sigptr2 + (List.rev acc, Some(varargs)), sigptr else - let x,sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let x, sigptr = sigptrGetTy ctxt numtypars bytes sigptr sigptrGetArgTys ctxt (n-1) numtypars bytes sigptr (x::acc) and sigptrGetLocal ctxt numtypars bytes sigptr = - let pinned,sigptr = + let pinned, sigptr = let b0, sigptr' = sigptrGetByte bytes sigptr if b0 = et_PINNED then true, sigptr' @@ -2089,64 +2089,64 @@ and sigptrGetLocal ctxt numtypars bytes sigptr = loc, sigptr and readBlobHeapAsMethodSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsMethodSig (BlobAsMethodSigIdx (numtypars, blobIdx)) -and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsMethodSigUncached ctxtH (BlobAsMethodSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr - let generic,cc = byteAsCallConv ccByte - let genarity,sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0,sigptr - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let (argtys,varargs),_sigptr = sigptrGetArgTys ctxt ( numparams) numtypars bytes sigptr [] - generic,genarity,cc,retty,argtys,varargs + let ccByte, sigptr = sigptrGetByte bytes sigptr + let generic, cc = byteAsCallConv ccByte + let genarity, sigptr = if generic then sigptrGetZInt32 bytes sigptr else 0x0, sigptr + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let (argtys, varargs), _sigptr = sigptrGetArgTys ctxt ( numparams) numtypars bytes sigptr [] + generic, genarity, cc, retty, argtys, varargs and readBlobHeapAsType ctxt numtypars blobIdx = let bytes = readBlobHeap ctxt blobIdx - let ty,_sigptr = sigptrGetTy ctxt numtypars bytes 0 + let ty, _sigptr = sigptrGetTy ctxt numtypars bytes 0 ty and readBlobHeapAsFieldSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsFieldSig (BlobAsFieldSigIdx (numtypars, blobIdx)) -and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsFieldSigUncached ctxtH (BlobAsFieldSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_FIELD then dprintn "warning: field sig was not CC_FIELD" - let retty,_sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let retty, _sigptr = sigptrGetTy ctxt numtypars bytes sigptr retty and readBlobHeapAsPropertySig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars,blobIdx)) -and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars,blobIdx)) = + ctxt.readBlobHeapAsPropertySig (BlobAsPropSigIdx (numtypars, blobIdx)) +and readBlobHeapAsPropertySigUncached ctxtH (BlobAsPropSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr let hasthis = byteAsHasThis ccByte let ccMaxked = (ccByte &&& 0x0Fuy) if ccMaxked <> e_IMAGE_CEE_CS_CALLCONV_PROPERTY then dprintn ("warning: property sig was "+string ccMaxked+" instead of CC_PROPERTY") - let numparams,sigptr = sigptrGetZInt32 bytes sigptr - let retty,sigptr = sigptrGetTy ctxt numtypars bytes sigptr - let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr - hasthis,retty,argtys + let numparams, sigptr = sigptrGetZInt32 bytes sigptr + let retty, sigptr = sigptrGetTy ctxt numtypars bytes sigptr + let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) ( numparams) bytes sigptr + hasthis, retty, argtys and readBlobHeapAsLocalsSig ctxt numtypars blobIdx = - ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars,blobIdx)) + ctxt.readBlobHeapAsLocalsSig (BlobAsLocalSigIdx (numtypars, blobIdx)) -and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars,blobIdx)) = +and readBlobHeapAsLocalsSigUncached ctxtH (BlobAsLocalSigIdx (numtypars, blobIdx)) = let ctxt = getHole ctxtH let bytes = readBlobHeap ctxt blobIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then dprintn "warning: local sig was not CC_LOCAL" - let numlocals,sigptr = sigptrGetZInt32 bytes sigptr - let localtys,_sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr + let numlocals, sigptr = sigptrGetZInt32 bytes sigptr + let localtys, _sigptr = sigptrFold (sigptrGetLocal ctxt numtypars) ( numlocals) bytes sigptr localtys and byteAsHasThis b = @@ -2165,45 +2165,45 @@ and byteAsCallConv b = elif ccMaxked = e_IMAGE_CEE_CS_CALLCONV_VARARG then ILArgConvention.VarArg else ILArgConvention.Default let generic = (b &&& e_IMAGE_CEE_CS_CALLCONV_GENERIC) <> 0x0uy - generic, Callconv (byteAsHasThis b,cc) + generic, Callconv (byteAsHasThis b, cc) and seekReadMemberRefAsMethodData ctxt numtypars idx : VarArgMethodData = - ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars,idx)) -and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars,idx)) = + ctxt.seekReadMemberRefAsMethodData (MemberRefAsMspecIdx (numtypars, idx)) +and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mrpIdx,nameIdx,typeIdx) = seekReadMemberRefRow ctxt idx + let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let enclTyp = seekReadMethodRefParent ctxt numtypars mrpIdx - let _generic,genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt enclTyp.GenericArgs.Length typeIdx + let _generic, genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt enclTyp.GenericArgs.Length typeIdx let minst = List.init genarity (fun n -> mkILTyvarTy (uint16 (numtypars+n))) - (VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty,minst)) + (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData = - let (VarArgMethodData(enclTyp, cc, nm, argtys,varargs, retty,minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx + let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = seekReadMemberRefAsMethodData ctxt numtypars idx if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" - (MethodData(enclTyp, cc, nm, argtys, retty,minst)) + (MethodData(enclTyp, cc, nm, argtys, retty, minst)) and seekReadMethodSpecAsMethodData ctxt numtypars idx = - ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars,idx)) -and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars,idx)) = + ctxt.seekReadMethodSpecAsMethodData (MethodSpecAsMspecIdx (numtypars, idx)) +and seekReadMethodSpecAsMethodDataUncached ctxtH (MethodSpecAsMspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mdorIdx,instIdx) = seekReadMethodSpecRow ctxt idx - let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty,_)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx + let (mdorIdx, instIdx) = seekReadMethodSpecRow ctxt idx + let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, _)) = seekReadMethodDefOrRef ctxt numtypars mdorIdx let minst = let bytes = readBlobHeap ctxt instIdx let sigptr = 0 - let ccByte,sigptr = sigptrGetByte bytes sigptr + let ccByte, sigptr = sigptrGetByte bytes sigptr if ccByte <> e_IMAGE_CEE_CS_CALLCONV_GENERICINST then dprintn ("warning: method inst ILCallingConv was "+string ccByte+" instead of CC_GENERICINST") - let numgpars,sigptr = sigptrGetZInt32 bytes sigptr - let argtys,_sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr + let numgpars, sigptr = sigptrGetZInt32 bytes sigptr + let argtys, _sigptr = sigptrFold (sigptrGetTy ctxt numtypars) numgpars bytes sigptr argtys - VarArgMethodData(enclTyp, cc, nm, argtys, varargs,retty, minst) + VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst) and seekReadMemberRefAsFieldSpec ctxt numtypars idx = - ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars,idx)) -and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars,idx)) = + ctxt.seekReadMemberRefAsFieldSpec (MemberRefAsFspecIdx (numtypars, idx)) +and seekReadMemberRefAsFieldSpecUncached ctxtH (MemberRefAsFspecIdx (numtypars, idx)) = let ctxt = getHole ctxtH - let (mrpIdx,nameIdx,typeIdx) = seekReadMemberRefRow ctxt idx + let (mrpIdx, nameIdx, typeIdx) = seekReadMemberRefRow ctxt idx let nm = readStringHeap ctxt nameIdx let enclTyp = seekReadMethodRefParent ctxt numtypars mrpIdx let retty = readBlobHeapAsFieldSig ctxt numtypars typeIdx @@ -2221,15 +2221,15 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = let ctxt = getHole ctxtH // Look for the method def parent. let tidx = - seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, - (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), - (fun r -> r), - (fun (_,((_, _, _, _, _, methodsIdx), + seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, + (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), + (fun r -> r), + (fun (_, ((_, _, _, _, _, methodsIdx), (_, endMethodsIdx))) -> if endMethodsIdx <= idx then 1 elif methodsIdx <= idx && idx < endMethodsIdx then 0 - else -1), - true,fst) + else -1), + true, fst) // Create a formal instantiation if needed let typeGenericArgs = seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx) let typeGenericArgsCount = typeGenericArgs.Length @@ -2246,7 +2246,7 @@ and seekReadMethodDefAsMethodDataUncached ctxtH idx = let nm = readStringHeap ctxt nameIdx // Read the method def signature. - let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx + let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt typeGenericArgsCount typeIdx if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef token signature" MethodData(enclTyp, cc, nm, argtys, retty, minst) @@ -2261,18 +2261,18 @@ and seekReadFieldDefAsFieldSpecUncached ctxtH idx = let nm = readStringHeap ctxt nameIdx (* Look for the field def parent. *) let tidx = - seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, - (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), - (fun r -> r), - (fun (_,((_, _, _, _, fieldsIdx, _),(endFieldsIdx, _))) -> + seekReadIndexedRow (ctxt.getNumRows TableNames.TypeDef, + (fun i -> i, seekReadTypeDefRowWithExtents ctxt i), + (fun r -> r), + (fun (_, ((_, _, _, _, fieldsIdx, _), (endFieldsIdx, _))) -> if endFieldsIdx <= idx then 1 elif fieldsIdx <= idx && idx < endFieldsIdx then 0 - else -1), - true,fst) + else -1), + true, fst) // Read the field signature. let retty = readBlobHeapAsFieldSig ctxt 0 typeIdx // Create a formal instantiation if needed - let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef,tidx)) + let finst = mkILFormalGenericArgs 0 (seekReadGenericParams ctxt 0 (tomd_TypeDef, tidx)) // Read the field def parent. let enclTyp = seekReadTypeDefAsType ctxt AsObject (* not ok: see note *) finst tidx // Put it together. @@ -2305,17 +2305,17 @@ and seekReadMethod ctxt numtypars (idx:int) = let mustrun = (implflags &&& 0x0040) <> 0x0 let cctor = (nm = ".cctor") let ctor = (nm = ".ctor") - let _generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx + let _generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars typeIdx if varargs <> None then dprintf "ignoring sentinel and varargs in ILMethodDef signature" let endParamIdx = if idx >= ctxt.getNumRows TableNames.Method then ctxt.getNumRows TableNames.Param + 1 else - let (_,_,_,_,_, paramIdx) = seekReadMethodRow ctxt (idx + 1) + let (_, _, _, _, _, paramIdx) = seekReadMethodRow ctxt (idx + 1) paramIdx - let ret,ilParams = seekReadParams ctxt (retty,argtys) paramIdx endParamIdx + let ret, ilParams = seekReadParams ctxt (retty, argtys) paramIdx endParamIdx { Name=nm mdKind = @@ -2330,7 +2330,7 @@ and seekReadMethod ctxt numtypars (idx:int) = IsAbstract=abstr } else MethodKind.NonVirtual) Access = memberAccessOfFlags flags - SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef,idx)) + SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef, idx)) HasSecurity=hassec IsEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx) IsReqSecObj=reqsecobj @@ -2346,8 +2346,8 @@ and seekReadMethod ctxt numtypars (idx:int) = IsInternalCall = internalcall IsForwardRef = forwardref mdCodeKind = (if (codetype = 0x00) then MethodCodeKind.IL elif (codetype = 0x01) then MethodCodeKind.Native elif (codetype = 0x03) then MethodCodeKind.Runtime else MethodCodeKind.Native) - GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef,idx) - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef,idx)) + GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx) + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef, idx)) Parameters= ilParams CallingConv=cc Return=ret @@ -2360,11 +2360,11 @@ and seekReadMethod ctxt numtypars (idx:int) = //if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA" mkMethBodyLazyAux (notlazy MethodBody.Abstract) else - seekReadMethodRVA ctxt (idx,nm,internalcall,noinline,aggressiveinline,numtypars) codeRVA + seekReadMethodRVA ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA } -and seekReadParams ctxt (retty,argtys) pidx1 pidx2 = +and seekReadParams ctxt (retty, argtys) pidx1 pidx2 = let retRes : ILReturn ref = ref { Marshal=None; Type=retty; CustomAttrs=emptyILCustomAttrs } let paramsRes : ILParameter [] = argtys @@ -2379,26 +2379,26 @@ and seekReadParams ctxt (retty,argtys) pidx1 pidx2 = Type=ty CustomAttrs=emptyILCustomAttrs }) for i = pidx1 to pidx2 - 1 do - seekReadParamExtras ctxt (retRes,paramsRes) i + seekReadParamExtras ctxt (retRes, paramsRes) i !retRes, List.ofArray paramsRes -and seekReadParamExtras ctxt (retRes,paramsRes) (idx:int) = - let (flags,seq,nameIdx) = seekReadParamRow ctxt idx +and seekReadParamExtras ctxt (retRes, paramsRes) (idx:int) = + let (flags, seq, nameIdx) = seekReadParamRow ctxt idx let inOutMasked = (flags &&& 0x00FF) let hasMarshal = (flags &&& 0x2000) <> 0x0 let hasDefault = (flags &&& 0x1000) <> 0x0 - let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal,seekReadFieldMarshalRow ctxt,fst,hfmCompare idx,isSorted ctxt TableNames.FieldMarshal,(snd >> readBlobHeapAsNativeType ctxt)) - let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_ParamDef,idx)) + let fmReader idx = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt, fst, hfmCompare idx, isSorted ctxt TableNames.FieldMarshal, (snd >> readBlobHeapAsNativeType ctxt)) + let cas = seekReadCustomAttrs ctxt (TaggedIndex(hca_ParamDef, idx)) if seq = 0 then retRes := { !retRes with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) CustomAttrs = cas } elif seq > Array.length paramsRes then dprintn "bad seq num. for param" else paramsRes.[seq - 1] <- { paramsRes.[seq - 1] with - Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef,idx))) else None) - Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef,idx))) else None) + Marshal=(if hasMarshal then Some (fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) + Default = (if hasDefault then Some (seekReadConstant ctxt (TaggedIndex(hc_ParamDef, idx))) else None) Name = readStringHeapOption ctxt nameIdx IsIn = ((inOutMasked &&& 0x0001) <> 0x0) IsOut = ((inOutMasked &&& 0x0002) <> 0x0) @@ -2408,27 +2408,27 @@ and seekReadParamExtras ctxt (retRes,paramsRes) (idx:int) = and seekReadMethodImpls ctxt numtypars tidx = mkILMethodImplsLazy (lazy - let mimpls = seekReadIndexedRows (ctxt.getNumRows TableNames.MethodImpl,seekReadMethodImplRow ctxt,(fun (a,_,_) -> a),simpleIndexCompare tidx,isSorted ctxt TableNames.MethodImpl,(fun (_,b,c) -> b,c)) - mimpls |> List.map (fun (b,c) -> + let mimpls = seekReadIndexedRows (ctxt.getNumRows TableNames.MethodImpl, seekReadMethodImplRow ctxt, (fun (a, _, _) -> a), simpleIndexCompare tidx, isSorted ctxt TableNames.MethodImpl, (fun (_, b, c) -> b, c)) + mimpls |> List.map (fun (b, c) -> { OverrideBy= - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b - mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars b + mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) Overrides= - let (MethodData(enclTyp, cc, nm, argtys, retty,minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c - let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty,minst) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars c + let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) OverridesSpec(mspec.MethodRef, mspec.EnclosingType) })) -and seekReadMultipleMethodSemantics ctxt (flags,id) = +and seekReadMultipleMethodSemantics ctxt (flags, id) = seekReadIndexedRows - (ctxt.getNumRows TableNames.MethodSemantics , - seekReadMethodSemanticsRow ctxt, - (fun (_flags,_,c) -> c), - hsCompare id, - isSorted ctxt TableNames.MethodSemantics, - (fun (a,b,_c) -> + (ctxt.getNumRows TableNames.MethodSemantics , + seekReadMethodSemanticsRow ctxt, + (fun (_flags, _, c) -> c), + hsCompare id, + isSorted ctxt TableNames.MethodSemantics, + (fun (a, b, _c) -> let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefAsMethodData ctxt b a, (mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)).MethodRef)) - |> List.filter (fun (flags2,_) -> flags = flags2) + |> List.filter (fun (flags2, _) -> flags = flags2) |> List.map snd @@ -2444,24 +2444,24 @@ and seekReadMethodSemantics ctxt id = | Some x -> x and seekReadEvent ctxt numtypars idx = - let (flags,nameIdx,typIdx) = seekReadEventRow ctxt idx + let (flags, nameIdx, typIdx) = seekReadEventRow ctxt idx { Name = readStringHeap ctxt nameIdx Type = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx IsSpecialName = (flags &&& 0x0200) <> 0x0 IsRTSpecialName = (flags &&& 0x0400) <> 0x0 - AddMethod= seekReadMethodSemantics ctxt (0x0008,TaggedIndex(hs_Event, idx)) - RemoveMethod=seekReadMethodSemantics ctxt (0x0010,TaggedIndex(hs_Event,idx)) - FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020,TaggedIndex(hs_Event,idx)) + AddMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx)) + RemoveMethod=seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx)) + FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx)) OtherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)) - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event,idx)) } + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event, idx)) } (* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table is sorted according to ILTypeDef tokens and then doing a binary chop *) and seekReadEvents ctxt numtypars tidx = mkILEventsLazy (lazy - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.EventMap,(fun i -> i, seekReadEventMapRow ctxt i),(fun (_,row) -> fst row),compare tidx,false,(fun (i,row) -> (i,snd row))) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.EventMap, (fun i -> i, seekReadEventMapRow ctxt i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with | None -> [] - | Some (rowNum,beginEventIdx) -> + | Some (rowNum, beginEventIdx) -> let endEventIdx = if rowNum >= ctxt.getNumRows TableNames.EventMap then ctxt.getNumRows TableNames.Event + 1 @@ -2473,10 +2473,10 @@ and seekReadEvents ctxt numtypars tidx = yield seekReadEvent ctxt numtypars i ]) and seekReadProperty ctxt numtypars idx = - let (flags,nameIdx,typIdx) = seekReadPropertyRow ctxt idx - let cc,retty,argtys = readBlobHeapAsPropertySig ctxt numtypars typIdx - let setter= seekReadoptional_MethodSemantics ctxt (0x0001,TaggedIndex(hs_Property,idx)) - let getter = seekReadoptional_MethodSemantics ctxt (0x0002,TaggedIndex(hs_Property,idx)) + let (flags, nameIdx, typIdx) = seekReadPropertyRow ctxt idx + let cc, retty, argtys = readBlobHeapAsPropertySig ctxt numtypars typIdx + let setter= seekReadoptional_MethodSemantics ctxt (0x0001, TaggedIndex(hs_Property, idx)) + let getter = seekReadoptional_MethodSemantics ctxt (0x0002, TaggedIndex(hs_Property, idx)) (* NOTE: the "ThisConv" value on the property is not reliable: better to look on the getter/setter *) (* NOTE: e.g. tlbimp on Office msword.olb seems to set this incorrectly *) let cc2 = @@ -2493,16 +2493,16 @@ and seekReadProperty ctxt numtypars idx = SetMethod=setter GetMethod=getter Type=retty - Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property,idx))) + Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property, idx))) Args=argtys - CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property,idx)) } + CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property, idx)) } and seekReadProperties ctxt numtypars tidx = mkILPropertiesLazy (lazy - match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.PropertyMap,(fun i -> i, seekReadPropertyMapRow ctxt i),(fun (_,row) -> fst row),compare tidx,false,(fun (i,row) -> (i,snd row))) with + match seekReadOptionalIndexedRow (ctxt.getNumRows TableNames.PropertyMap, (fun i -> i, seekReadPropertyMapRow ctxt i), (fun (_, row) -> fst row), compare tidx, false, (fun (i, row) -> (i, snd row))) with | None -> [] - | Some (rowNum,beginPropIdx) -> + | Some (rowNum, beginPropIdx) -> let endPropIdx = if rowNum >= ctxt.getNumRows TableNames.PropertyMap then ctxt.getNumRows TableNames.Property + 1 @@ -2516,19 +2516,19 @@ and seekReadProperties ctxt numtypars tidx = and seekReadCustomAttrs ctxt idx = mkILComputedCustomAttrs (fun () -> - seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, - seekReadCustomAttributeRow ctxt,(fun (a,_,_) -> a), - hcaCompare idx, - isSorted ctxt TableNames.CustomAttribute, - (fun (_,b,c) -> seekReadCustomAttr ctxt (b,c))) + seekReadIndexedRows (ctxt.getNumRows TableNames.CustomAttribute, + seekReadCustomAttributeRow ctxt, (fun (a, _, _) -> a), + hcaCompare idx, + isSorted ctxt TableNames.CustomAttribute, + (fun (_, b, c) -> seekReadCustomAttr ctxt (b, c))) |> List.toArray) -and seekReadCustomAttr ctxt (TaggedIndex(cat,idx),b) = - ctxt.seekReadCustomAttr (CustomAttrIdx (cat,idx,b)) +and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) = + ctxt.seekReadCustomAttr (CustomAttrIdx (cat, idx, b)) -and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = +and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat, idx, valIdx)) = let ctxt = getHole ctxtH - { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat,idx)) + { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat, idx)) Data= match readBlobHeapOption ctxt valIdx with | Some bytes -> bytes @@ -2538,27 +2538,27 @@ and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = and seekReadSecurityDecls ctxt idx = mkILLazySecurityDecls (lazy - seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, - seekReadPermissionRow ctxt, - (fun (_,par,_) -> par), - hdsCompare idx, - isSorted ctxt TableNames.Permission, - (fun (act,_,ty) -> seekReadSecurityDecl ctxt (act,ty)))) + seekReadIndexedRows (ctxt.getNumRows TableNames.Permission, + seekReadPermissionRow ctxt, + (fun (_, par, _) -> par), + hdsCompare idx, + isSorted ctxt TableNames.Permission, + (fun (act, _, ty) -> seekReadSecurityDecl ctxt (act, ty)))) -and seekReadSecurityDecl ctxt (a,b) = - ctxt.seekReadSecurityDecl (SecurityDeclIdx (a,b)) +and seekReadSecurityDecl ctxt (a, b) = + ctxt.seekReadSecurityDecl (SecurityDeclIdx (a, b)) -and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act,ty)) = +and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act, ty)) = let ctxt = getHole ctxtH - PermissionSet ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), + PermissionSet ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"), readBlobHeap ctxt ty) and seekReadConstant ctxt idx = - let kind,vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, - seekReadConstantRow ctxt, - (fun (_,key,_) -> key), - hcCompare idx,isSorted ctxt TableNames.Constant,(fun (kind,_,v) -> kind,v)) + let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant, + seekReadConstantRow ctxt, + (fun (_, key, _) -> key), + hcCompare idx, isSorted ctxt TableNames.Constant, (fun (kind, _, v) -> kind, v)) match kind with | x when x = uint16 et_STRING -> let blobHeap = readBlobHeap ctxt vidx @@ -2582,12 +2582,12 @@ and seekReadConstant ctxt idx = and seekReadImplMap ctxt nm midx = mkMethBodyLazyAux (lazy - let (flags,nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, - seekReadImplMapRow ctxt, - (fun (_,m,_,_) -> m), - mfCompare (TaggedIndex(mf_MethodDef,midx)), - isSorted ctxt TableNames.ImplMap, - (fun (a,_,c,d) -> a,c,d)) + let (flags, nameIdx, scopeIdx) = seekReadIndexedRow (ctxt.getNumRows TableNames.ImplMap, + seekReadImplMapRow ctxt, + (fun (_, m, _, _) -> m), + mfCompare (TaggedIndex(mf_MethodDef, midx)), + isSorted ctxt TableNames.ImplMap, + (fun (a, _, c, d) -> a, c, d)) let cc = let masked = flags &&& 0x0700 if masked = 0x0000 then PInvokeCallingConvention.None @@ -2630,8 +2630,8 @@ and seekReadImplMap ctxt nm midx = Where = seekReadModuleRef ctxt scopeIdx }) and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = - let labelsOfRawOffsets = new Dictionary<_,_>(sz/2) - let ilOffsetsOfLabels = new Dictionary<_,_>(sz/2) + let labelsOfRawOffsets = new Dictionary<_, _>(sz/2) + let ilOffsetsOfLabels = new Dictionary<_, _>(sz/2) let tryRawToLabel rawOffset = if labelsOfRawOffsets.ContainsKey rawOffset then Some(labelsOfRawOffsets.[rawOffset]) @@ -2676,11 +2676,11 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = // Insert any sequence points into the instruction sequence while (match !seqPointsRemaining with - | (i,_tag) :: _rest when i <= !curr -> true + | (i, _tag) :: _rest when i <= !curr -> true | _ -> false) do // Emitting one sequence point - let (_,tag) = List.head !seqPointsRemaining + let (_, tag) = List.head !seqPointsRemaining seqPointsRemaining := List.tail !seqPointsRemaining ibuf.Add (I_seqpoint tag) @@ -2759,7 +2759,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = curr := !curr + 8 f prefixes x | I_field_instr f -> - let (tab,tok) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, tok) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let fspec = if tab = TableNames.Field then @@ -2771,7 +2771,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = | I_method_instr f -> // method instruction, curr = "+string !curr - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let (VarArgMethodData(enclTyp, cc, nm, argtys, varargs, retty, minst)) = if tab = TableNames.Method then @@ -2782,23 +2782,23 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = seekReadMethodSpecAsMethodData ctxt numtypars idx else failwith "bad table in MethodDefOrRefOrSpec" match enclTyp with - | ILType.Array (shape,ty) -> + | ILType.Array (shape, ty) -> match nm with - | "Get" -> I_ldelem_any(shape,ty) - | "Set" -> I_stelem_any(shape,ty) - | "Address" -> I_ldelema(prefixes.ro,false,shape,ty) - | ".ctor" -> I_newarr(shape,ty) + | "Get" -> I_ldelem_any(shape, ty) + | "Set" -> I_stelem_any(shape, ty) + | "Address" -> I_ldelema(prefixes.ro, false, shape, ty) + | ".ctor" -> I_newarr(shape, ty) | _ -> failwith "bad method on array type" | _ -> let mspec = mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst) - f prefixes (mspec,varargs) + f prefixes (mspec, varargs) | I_type_instr f -> let uncoded = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 let typ = seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec uncoded) f prefixes typ | I_string_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 if tab <> TableNames.UserStrings then dprintn "warning: bad table in user string for ldstr" f prefixes (readUserStringHeap ctxt (idx)) @@ -2824,29 +2824,29 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = let dest = !curr + offsDest f prefixes (rawToLabel dest) | I_invalid_instr -> - dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ","+string !lastb2 else "")) + dprintn ("invalid instruction: "+string !lastb+ (if !lastb = 0xfe then ", "+string !lastb2 else "")) I_ret | I_tok_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 (* REVIEW: this incorrectly labels all MemberRef tokens as ILMethod's: we should go look at the MemberRef sig to determine if it is a field or method *) let token_info = if tab = TableNames.Method || tab = TableNames.MemberRef (* REVIEW:generics or tab = TableNames.MethodSpec *) then - let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab,idx)) + let (MethodData(enclTyp, cc, nm, argtys, retty, minst)) = seekReadMethodDefOrRefNoVarargs ctxt numtypars (uncodedTokenToMethodDefOrRef (tab, idx)) ILToken.ILMethod (mkILMethSpecInTy (enclTyp, cc, nm, argtys, retty, minst)) elif tab = TableNames.Field then ILToken.ILField (seekReadFieldDefAsFieldSpec ctxt idx) elif tab = TableNames.TypeDef || tab = TableNames.TypeRef || tab = TableNames.TypeSpec then - ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab,idx))) + ILToken.ILType (seekReadTypeDefOrRef ctxt numtypars AsObject [] (uncodedTokenToTypeDefOrRefOrSpec (tab, idx))) else failwith "bad token for ldtoken" f prefixes token_info | I_sig_instr f -> - let (tab,idx) = seekReadUncodedToken ctxt.is (start + (!curr)) + let (tab, idx) = seekReadUncodedToken ctxt.is (start + (!curr)) curr := !curr + 4 if tab <> TableNames.StandAloneSig then dprintn "strange table for callsig token" - let generic,_genarity,cc,retty,argtys,varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt idx) + let generic, _genarity, cc, retty, argtys, varargs = readBlobHeapAsMethodSig ctxt numtypars (seekReadStandAloneSigRow ctxt idx) if generic then failwith "bad image: a generic method signature ctxt.is begin used at a calli instruction" - f prefixes (mkILCallSig (cc,argtys,retty), varargs) + f prefixes (mkILCallSig (cc, argtys, retty), varargs) | I_switch_instr f -> let n = (seekReadInt32 ctxt.is (start + (!curr))) curr := !curr + 4 @@ -2877,12 +2877,12 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = elif isInstrStart (rawOffset+1) then rawToLabel (rawOffset+1) else failwith ("the bytecode raw offset "+string rawOffset+" did not refer either to the start or end of an instruction") let instrs = ibuf.ToArray() - instrs,rawToLabel, lab2pc, raw2nextLab + instrs, rawToLabel, lab2pc, raw2nextLab #if FX_NO_PDB_READER -and seekReadMethodRVA ctxt (_idx,nm,_internalcall,noinline,aggressiveinline,numtypars) rva = +and seekReadMethodRVA ctxt (_idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = #else -and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numtypars) rva = +and seekReadMethodRVA ctxt (idx, nm, _internalcall, noinline, aggressiveinline, numtypars) rva = #endif mkMethBodyLazyAux (lazy @@ -2905,61 +2905,61 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let pdbm = pdbReaderGetMethod pdbr (uncodedToken TableNames.Method idx) let sps = pdbMethodGetSequencePoints pdbm (*dprintf "#sps for 0x%x = %d\n" (uncodedToken TableNames.Method idx) (Array.length sps) *) - (* let roota,rootb = pdbScopeGetOffsets rootScope in *) + (* let roota, rootb = pdbScopeGetOffsets rootScope in *) let seqpoints = let arr = sps |> Array.map (fun sp -> (* It is VERY annoying to have to call GetURL for the document for each sequence point. This appears to be a short coming of the PDB reader API. They should return an index into the array of documents for the reader *) let sourcedoc = get_doc (pdbDocumentGetURL sp.pdbSeqPointDocument) let source = - ILSourceMarker.Create(document = sourcedoc, - line = sp.pdbSeqPointLine, - column = sp.pdbSeqPointColumn, - endLine = sp.pdbSeqPointEndLine, + ILSourceMarker.Create(document = sourcedoc, + line = sp.pdbSeqPointLine, + column = sp.pdbSeqPointColumn, + endLine = sp.pdbSeqPointEndLine, endColumn = sp.pdbSeqPointEndColumn) - (sp.pdbSeqPointOffset,source)) + (sp.pdbSeqPointOffset, source)) Array.sortInPlaceBy fst arr Array.toList arr let rec scopes scp = - let a,b = pdbScopeGetOffsets scp + let a, b = pdbScopeGetOffsets scp let lvs = pdbScopeGetLocals scp let ilvs = lvs |> Array.toList |> List.filter (fun l -> - let k,_idx = pdbVariableGetAddressAttributes l + let k, _idx = pdbVariableGetAddressAttributes l k = 1 (* ADDR_IL_OFFSET *)) let ilinfos : ILLocalDebugMapping list = ilvs |> List.map (fun ilv -> - let _k,idx = pdbVariableGetAddressAttributes ilv + let _k, idx = pdbVariableGetAddressAttributes ilv let n = pdbVariableGetName ilv { LocalIndex= idx LocalName=n}) let thisOne = (fun raw2nextLab -> - { Range= (raw2nextLab a,raw2nextLab b) + { Range= (raw2nextLab a, raw2nextLab b) DebugMappings = ilinfos } : ILLocalDebugInfo ) let others = List.foldBack (scopes >> (@)) (Array.toList (pdbScopeGetChildren scp)) [] thisOne :: others let localPdbInfos = [] (* scopes fail for mscorlib scopes rootScope *) // REVIEW: look through sps to get ranges? Use GetRanges?? Change AbsIL?? - (localPdbInfos,None,seqpoints) + (localPdbInfos, None, seqpoints) with e -> // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message - [],None,[] + [], None, [] #endif - let baseRVA = ctxt.anyV2P("method rva",rva) + let baseRVA = ctxt.anyV2P("method rva", rva) // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA let b = seekReadByte ctxt.is baseRVA if (b &&& e_CorILMethod_FormatMask) = e_CorILMethod_TinyFormat then let codeBase = baseRVA + 1 let codeSize = (int32 b >>>& 2) // tiny format for "+nm+", code size = " + string codeSize) - let instrs,_,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars codeSize codeBase seqpoints + let instrs, _, lab2pc, raw2nextLab = seekReadTopCode ctxt numtypars codeSize codeBase seqpoints (* Convert the linear code format to the nested code format *) let localPdbInfos2 = List.map (fun f -> f raw2nextLab) localPdbInfos let code = buildILCode nm lab2pc instrs [] localPdbInfos2 @@ -2977,7 +2977,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let initlocals = (b &&& e_CorILMethod_InitLocals) <> 0x0uy let maxstack = seekReadUInt16AsInt32 ctxt.is (baseRVA + 2) let codeSize = seekReadInt32 ctxt.is (baseRVA + 4) - let localsTab,localToken = seekReadUncodedToken ctxt.is (baseRVA + 8) + let localsTab, localToken = seekReadUncodedToken ctxt.is (baseRVA + 8) let codeBase = baseRVA + 12 let locals = if localToken = 0x0 then [] @@ -2985,10 +2985,10 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty if localsTab <> TableNames.StandAloneSig then dprintn "strange table for locals token" readBlobHeapAsLocalsSig ctxt numtypars (seekReadStandAloneSigRow ctxt localToken) - // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+",b = "+string b) + // fat format for "+nm+", code size = " + string codeSize+", hasMoreSections = "+(if hasMoreSections then "true" else "false")+", b = "+string b) // Read the method body - let instrs,rawToLabel,lab2pc,raw2nextLab = seekReadTopCode ctxt numtypars ( codeSize) codeBase seqpoints + let instrs, rawToLabel, lab2pc, raw2nextLab = seekReadTopCode ctxt numtypars ( codeSize) codeBase seqpoints // Read all the sections that follow the method body. // These contain the exception clauses. @@ -3018,7 +3018,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let st2 = seekReadInt32 ctxt.is (clauseBase + 12) let sz2 = seekReadInt32 ctxt.is (clauseBase + 16) let extra = seekReadInt32 ctxt.is (clauseBase + 20) - (kind,st1,sz1,st2,sz2,extra)) + (kind, st1, sz1, st2, sz2, extra)) else [] bigSize, clauses else @@ -3039,17 +3039,17 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty let st2 = seekReadUInt16AsInt32 ctxt.is (clauseBase + 5) let sz2 = seekReadByteAsInt32 ctxt.is (clauseBase + 7) let extra = seekReadInt32 ctxt.is (clauseBase + 8) - (kind,st1,sz1,st2,sz2,extra)) + (kind, st1, sz1, st2, sz2, extra)) else [] smallSize, clauses // Morph together clauses that cover the same range let sehClauses = - let sehMap = Dictionary<_,_>(clauses.Length, HashIdentity.Structural) + let sehMap = Dictionary<_, _>(clauses.Length, HashIdentity.Structural) List.iter - (fun (kind,st1,sz1,st2,sz2,extra) -> + (fun (kind, st1, sz1, st2, sz2, extra) -> let tryStart = rawToLabel st1 let tryFinish = rawToLabel (st1 + sz1) let handlerStart = rawToLabel st2 @@ -3077,7 +3077,7 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,aggressiveinline,numty else sehMap.[key] <- [clause]) clauses - ([],sehMap) ||> Seq.fold (fun acc (KeyValue(key,bs)) -> [ for b in bs -> {Range=key; Clause=b} : ILExceptionSpec ] @ acc) + ([], sehMap) ||> Seq.fold (fun acc (KeyValue(key, bs)) -> [ for b in bs -> {Range=key; Clause=b} : ILExceptionSpec ] @ acc) seh := sehClauses moreSections := (sectionFlag &&& e_CorILMethod_Sect_MoreSects) <> 0x0uy nextSectionBase := sectionBase + sectionSize @@ -3113,89 +3113,89 @@ and int32AsILVariantType ctxt (n:int32) = and readBlobHeapAsNativeType ctxt blobIdx = // reading native type blob "+string blobIdx) let bytes = readBlobHeap ctxt blobIdx - let res,_ = sigptrGetILNativeType ctxt bytes 0 + let res, _ = sigptrGetILNativeType ctxt bytes 0 res and sigptrGetILNativeType ctxt bytes sigptr = // reading native type blob, sigptr= "+string sigptr) - let ntbyte,sigptr = sigptrGetByte bytes sigptr + let ntbyte, sigptr = sigptrGetByte bytes sigptr if List.memAssoc ntbyte (Lazy.force ILNativeTypeMap) then List.assoc ntbyte (Lazy.force ILNativeTypeMap), sigptr elif ntbyte = 0x0uy then ILNativeType.Empty, sigptr elif ntbyte = nt_CUSTOMMARSHALER then // reading native type blob (CM1) , sigptr= "+string sigptr+ ", bytes.Length = "+string bytes.Length) - let guidLen,sigptr = sigptrGetZInt32 bytes sigptr + let guidLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM2) , sigptr= "+string sigptr+", guidLen = "+string ( guidLen)) - let guid,sigptr = sigptrGetBytes ( guidLen) bytes sigptr + let guid, sigptr = sigptrGetBytes ( guidLen) bytes sigptr // reading native type blob (CM3) , sigptr= "+string sigptr) - let nativeTypeNameLen,sigptr = sigptrGetZInt32 bytes sigptr + let nativeTypeNameLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeNameLen = "+string ( nativeTypeNameLen)) - let nativeTypeName,sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr + let nativeTypeName, sigptr = sigptrGetString ( nativeTypeNameLen) bytes sigptr // reading native type blob (CM4) , sigptr= "+string sigptr+", nativeTypeName = "+nativeTypeName) // reading native type blob (CM5) , sigptr= "+string sigptr) - let custMarshallerNameLen,sigptr = sigptrGetZInt32 bytes sigptr + let custMarshallerNameLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM6) , sigptr= "+string sigptr+", custMarshallerNameLen = "+string ( custMarshallerNameLen)) - let custMarshallerName,sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr + let custMarshallerName, sigptr = sigptrGetString ( custMarshallerNameLen) bytes sigptr // reading native type blob (CM7) , sigptr= "+string sigptr+", custMarshallerName = "+custMarshallerName) - let cookieStringLen,sigptr = sigptrGetZInt32 bytes sigptr + let cookieStringLen, sigptr = sigptrGetZInt32 bytes sigptr // reading native type blob (CM8) , sigptr= "+string sigptr+", cookieStringLen = "+string ( cookieStringLen)) - let cookieString,sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr + let cookieString, sigptr = sigptrGetBytes ( cookieStringLen) bytes sigptr // reading native type blob (CM9) , sigptr= "+string sigptr) - ILNativeType.Custom (guid,nativeTypeName,custMarshallerName,cookieString), sigptr + ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString), sigptr elif ntbyte = nt_FIXEDSYSSTRING then - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr ILNativeType.FixedSysString i, sigptr elif ntbyte = nt_FIXEDARRAY then - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr ILNativeType.FixedArray i, sigptr elif ntbyte = nt_SAFEARRAY then (if sigptr >= bytes.Length then - ILNativeType.SafeArray(ILNativeVariant.Empty, None),sigptr + ILNativeType.SafeArray(ILNativeVariant.Empty, None), sigptr else - let i,sigptr = sigptrGetZInt32 bytes sigptr + let i, sigptr = sigptrGetZInt32 bytes sigptr if sigptr >= bytes.Length then ILNativeType.SafeArray (int32AsILVariantType ctxt i, None), sigptr else - let len,sigptr = sigptrGetZInt32 bytes sigptr - let s,sigptr = sigptrGetString ( len) bytes sigptr + let len, sigptr = sigptrGetZInt32 bytes sigptr + let s, sigptr = sigptrGetString ( len) bytes sigptr ILNativeType.SafeArray (int32AsILVariantType ctxt i, Some s), sigptr) elif ntbyte = nt_ARRAY then if sigptr >= bytes.Length then - ILNativeType.Array(None,None),sigptr + ILNativeType.Array(None, None), sigptr else - let nt,sigptr = - let u,sigptr' = sigptrGetZInt32 bytes sigptr + let nt, sigptr = + let u, sigptr' = sigptrGetZInt32 bytes sigptr if (u = int nt_MAX) then ILNativeType.Empty, sigptr' else // NOTE: go back to start and read native type sigptrGetILNativeType ctxt bytes sigptr if sigptr >= bytes.Length then - ILNativeType.Array (Some nt,None), sigptr + ILNativeType.Array (Some nt, None), sigptr else - let pnum,sigptr = sigptrGetZInt32 bytes sigptr + let pnum, sigptr = sigptrGetZInt32 bytes sigptr if sigptr >= bytes.Length then - ILNativeType.Array (Some nt,Some(pnum,None)), sigptr + ILNativeType.Array (Some nt, Some(pnum, None)), sigptr else - let additive,sigptr = + let additive, sigptr = if sigptr >= bytes.Length then 0, sigptr else sigptrGetZInt32 bytes sigptr - ILNativeType.Array (Some nt,Some(pnum,Some(additive))), sigptr + ILNativeType.Array (Some nt, Some(pnum, Some(additive))), sigptr else (ILNativeType.Empty, sigptr) and seekReadManifestResources ctxt () = mkILResourcesLazy (lazy [ for i = 1 to ctxt.getNumRows TableNames.ManifestResource do - let (offset,flags,nameIdx,implIdx) = seekReadManifestResourceRow ctxt i + let (offset, flags, nameIdx, implIdx) = seekReadManifestResourceRow ctxt i let scoref = seekReadImplAsScopeRef ctxt implIdx let datalab = match scoref with | ILScopeRef.Local -> - let start = ctxt.anyV2P ("resource",offset + ctxt.resourcesAddr) + let start = ctxt.anyV2P ("resource", offset + ctxt.resourcesAddr) let len = seekReadInt32 ctxt.is start ILResourceLocation.Local (fun () -> seekReadBytes ctxt.is (start + 4) len) - | ILScopeRef.Module mref -> ILResourceLocation.File (mref,offset) + | ILScopeRef.Module mref -> ILResourceLocation.File (mref, offset) | ILScopeRef.Assembly aref -> ILResourceLocation.Assembly aref let r = @@ -3210,14 +3210,14 @@ and seekReadNestedExportedTypes ctxt parentIdx = mkILNestedExportedTypesLazy (lazy [ for i = 1 to ctxt.getNumRows TableNames.ExportedType do - let (flags,_tok,nameIdx,namespaceIdx,implIdx) = seekReadExportedTypeRow ctxt i + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow ctxt i if not (isTopTypeDef flags) then - let (TaggedIndex(tag,idx) ) = implIdx + let (TaggedIndex(tag, idx) ) = implIdx //let isTopTypeDef = (idx = 0 || tag <> i_ExportedType) //if not isTopTypeDef then match tag with | tag when tag = i_ExportedType && idx = parentIdx -> - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) yield { Name=nm Access=(match typeAccessOfFlags flags with ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") @@ -3230,13 +3230,13 @@ and seekReadTopExportedTypes ctxt () = (lazy let res = ref [] for i = 1 to ctxt.getNumRows TableNames.ExportedType do - let (flags,_tok,nameIdx,namespaceIdx,implIdx) = seekReadExportedTypeRow ctxt i + let (flags, _tok, nameIdx, namespaceIdx, implIdx) = seekReadExportedTypeRow ctxt i if isTopTypeDef flags then - let (TaggedIndex(tag,_idx) ) = implIdx + let (TaggedIndex(tag, _idx) ) = implIdx // the nested types will be picked up by their enclosing types if tag <> i_ExportedType then - let nm = readBlobHeapAsTypeName ctxt (nameIdx,namespaceIdx) + let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) let scoref = seekReadImplAsScopeRef ctxt implIdx @@ -3260,13 +3260,13 @@ let getPdbReader opts infile = let pdbr = pdbReadOpen infile pdbpath let pdbdocs = pdbReaderGetDocuments pdbr - let tab = new Dictionary<_,_>(Array.length pdbdocs) + let tab = new Dictionary<_, _>(Array.length pdbdocs) pdbdocs |> Array.iter (fun pdbdoc -> let url = pdbDocumentGetURL pdbdoc tab.[url] <- - ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), - vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), - documentType = Some (pdbDocumentGetType pdbdoc), + ILSourceDocument.Create(language=Some (pdbDocumentGetLanguage pdbdoc), + vendor = Some (pdbDocumentGetLanguageVendor pdbdoc), + documentType = Some (pdbDocumentGetType pdbdoc), file = url)) let docfun url = if tab.ContainsKey url then tab.[url] else failwith ("Document with URL "+url+" not found in list of documents in the PDB file") @@ -3314,7 +3314,7 @@ let rec genOpenBinaryReader infile is opts = let _textAddr = seekReadInt32 is (peOptionalHeaderPhysLoc + 20) (* e.g. 0x0002000 *) (* x86: 000000b0 *) let dataSegmentAddr = seekReadInt32 is (peOptionalHeaderPhysLoc + 24) (* e.g. 0x0000c000 *) - (* REVIEW: For now, we'll use the DWORD at offset 24 for x64. This currently ok since fsc doesn't support true 64-bit image bases, + (* REVIEW: For now, we'll use the DWORD at offset 24 for x64. This currently ok since fsc doesn't support true 64-bit image bases, but we'll have to fix this up when such support is added. *) let imageBaseReal = if only64 then dataSegmentAddr else seekReadInt32 is (peOptionalHeaderPhysLoc + 28) (* Image Base Always 0x400000 (see Section 23.1). - QUERY : no it's not always 0x400000, e.g. 0x034f0000 *) let alignVirt = seekReadInt32 is (peOptionalHeaderPhysLoc + 32) (* Section Alignment Always 0x2000 (see Section 23.1). *) @@ -3375,7 +3375,7 @@ let rec genOpenBinaryReader infile is opts = let virtSize = seekReadInt32 is (pos + 8) let virtAddr = seekReadInt32 is (pos + 12) let physLoc = seekReadInt32 is (pos + 20) - yield (virtAddr,virtSize,physLoc) ] + yield (virtAddr, virtSize, physLoc) ] let findSectionHeader addr = let rec look i pos = @@ -3407,7 +3407,7 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": dataSegmentAddr (post section crack) = "+string dataSegmentAddr) - let anyV2P (n,v) = + let anyV2P (n, v) = let rec look i pos = if i >= numSections then (failwith (infile + ": bad "+n+", rva "+string v); 0x0) else @@ -3420,11 +3420,11 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": numSections = "+string numSections) if logging then dprintn (infile + ": cliHeaderAddr = "+string cliHeaderAddr) - if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header",cliHeaderAddr))) + if logging then dprintn (infile + ": cliHeaderPhys = "+string (anyV2P ("cli header", cliHeaderAddr))) if logging then dprintn (infile + ": dataSegmentSize = "+string dataSegmentSize) if logging then dprintn (infile + ": dataSegmentAddr = "+string dataSegmentAddr) - let cliHeaderPhysLoc = anyV2P ("cli header",cliHeaderAddr) + let cliHeaderPhysLoc = anyV2P ("cli header", cliHeaderAddr) let _majorRuntimeVersion = seekReadUInt16 is (cliHeaderPhysLoc + 4) let _minorRuntimeVersion = seekReadUInt16 is (cliHeaderPhysLoc + 6) @@ -3452,7 +3452,7 @@ let rec genOpenBinaryReader infile is opts = if logging then dprintn (infile + ": nativeResourcesAddr = "+string nativeResourcesAddr) if logging then dprintn (infile + ": nativeResourcesSize = "+string nativeResourcesSize) - let metadataPhysLoc = anyV2P ("metadata",metadataAddr) + let metadataPhysLoc = anyV2P ("metadata", metadataAddr) let magic = seekReadUInt16AsInt32 is metadataPhysLoc if magic <> 0x5342 then failwith (infile + ": bad metadata magic number: " + string magic) let magic2 = seekReadUInt16AsInt32 is (metadataPhysLoc + 2) @@ -3488,7 +3488,7 @@ let rec genOpenBinaryReader infile is opts = elif !n >= Array.length name || c <> name.[!n] then res := false incr n - if !res then Some(offset + metadataPhysLoc,length) + if !res then Some(offset + metadataPhysLoc, length) else look (i+1) (align 0x04 (pos + 8 + (!n))) look 0 streamHeadersStart @@ -3507,7 +3507,7 @@ let rec genOpenBinaryReader infile is opts = dprintf "no metadata tables found under stream names '#~' or '#-', please report this\n" let firstStreamOffset = seekReadInt32 is (streamHeadersStart + 0) let firstStreamLength = seekReadInt32 is (streamHeadersStart + 4) - firstStreamOffset,firstStreamLength + firstStreamOffset, firstStreamLength let (stringsStreamPhysicalLoc, stringsStreamSize) = findStream [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; |] (* #Strings *) let (userStringsStreamPhysicalLoc, userStringsStreamSize) = findStream [| 0x23; 0x55; 0x53; |] (* #US *) @@ -3931,10 +3931,10 @@ let rec genOpenBinaryReader infile is opts = countMethodSpec = countMethodSpec } ctxtH := Some ctxt - let ilModule = seekReadModule ctxt (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly,only32,is32bitpreferred,only64,platform,isDll, alignVirt,alignPhys,imageBaseReal,System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1 + let ilModule = seekReadModule ctxt (subsys, (subsysMajor, subsysMinor), useHighEnthropyVA, ilOnly, only32, is32bitpreferred, only64, platform, isDll, alignVirt, alignPhys, imageBaseReal, System.Text.Encoding.UTF8.GetString (ilMetadataVersion, 0, ilMetadataVersion.Length)) 1 let ilAssemblyRefs = lazy [ for i in 1 .. getNumRows TableNames.AssemblyRef do yield seekReadAssemblyRef ctxt i ] - ilModule,ilAssemblyRefs,pdb + ilModule, ilAssemblyRefs, pdb let mkDefault ilg = { optimizeForMemory=false @@ -3947,7 +3947,7 @@ let ClosePdbReader pdb = () #else match pdb with - | Some (pdbr,_) -> pdbReadClose pdbr + | Some (pdbr, _) -> pdbReadClose pdbr | None -> () #endif @@ -3955,7 +3955,7 @@ let OpenILModuleReader infile opts = try let mmap = MemoryMappedFile.Create infile - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mmap opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mmap opts { modul = modul ilAssemblyRefs=ilAssemblyRefs dispose = (fun () -> @@ -3963,7 +3963,7 @@ let OpenILModuleReader infile opts = ClosePdbReader pdb) } with _ -> let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mc opts { modul = modul ilAssemblyRefs = ilAssemblyRefs dispose = (fun () -> @@ -3971,20 +3971,20 @@ let OpenILModuleReader infile opts = // ++GLOBAL MUTABLE STATE (concurrency safe via locking) type ILModuleReaderCacheLockToken() = interface LockToken -let ilModuleReaderCache = new AgedLookup(0, areSimilar=(fun (x,y) -> x = y)) +let ilModuleReaderCache = new AgedLookup(0, areSimilar=(fun (x, y) -> x = y)) let ilModuleReaderCacheLock = Lock() let OpenILModuleReaderAfterReadingAllBytes infile opts = // Pseudo-normalize the paths. - let key,succeeded = + let key, succeeded = try (FileSystem.GetFullPathShim(infile), FileSystem.GetLastWriteTimeShim(infile), - opts.ilGlobals.primaryAssemblyScopeRef, + opts.ilGlobals.primaryAssemblyScopeRef, opts.pdbPath.IsSome), true with e -> System.Diagnostics.Debug.Assert(false, sprintf "Failed to compute key in OpenILModuleReaderAfterReadingAllBytes cache for '%s'. Falling back to uncached." infile) - ("",System.DateTime.Now,ILScopeRef.Local,false), false + ("", System.DateTime.Now, ILScopeRef.Local, false), false let cacheResult = if not succeeded then None // Fall back to uncached. @@ -3995,7 +3995,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = | Some(ilModuleReader) -> ilModuleReader | None -> let mc = ByteFile(infile |> FileSystem.ReadAllBytesShim) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader infile mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader infile mc opts let ilModuleReader = { modul = modul ilAssemblyRefs = ilAssemblyRefs @@ -4007,7 +4007,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts = let OpenILModuleReaderFromBytes fileNameForDebugOutput bytes opts = assert opts.pdbPath.IsNone let mc = ByteFile(bytes) - let modul,ilAssemblyRefs,pdb = genOpenBinaryReader fileNameForDebugOutput mc opts + let modul, ilAssemblyRefs, pdb = genOpenBinaryReader fileNameForDebugOutput mc opts let ilModuleReader = { modul = modul ilAssemblyRefs = ilAssemblyRefs diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 1f2a6fff60..f35e6e7b79 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -47,26 +47,25 @@ let wrapCustomAttr setCustomAttr (cinfo, bytes) = let logRefEmitCalls = false type System.Reflection.Emit.AssemblyBuilder with - member asmB.DefineDynamicModuleAndLog(a,b,c) = + member asmB.DefineDynamicModuleAndLog(a, b, c) = #if FX_RESHAPED_REFEMIT ignore b ignore c let modB = asmB.DefineDynamicModule(a) #else - let modB = asmB.DefineDynamicModule(a,b,c) - if logRefEmitCalls then printfn "let moduleBuilder%d = assemblyBuilder%d.DefineDynamicModule(%A,%A,%A)" (abs <| hash modB) (abs <| hash asmB) a b c + let modB = asmB.DefineDynamicModule(a, b, c) + if logRefEmitCalls then printfn "let moduleBuilder%d = assemblyBuilder%d.DefineDynamicModule(%A, %A, %A)" (abs <| hash modB) (abs <| hash asmB) a b c #endif modB - member asmB.SetCustomAttributeAndLog(cinfo,bytes) = + member asmB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash asmB) cinfo bytes wrapCustomAttr asmB.SetCustomAttribute (cinfo, bytes) -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT member asmB.AddResourceFileAndLog(nm1, nm2, attrs) = if logRefEmitCalls then printfn "assemblyBuilder%d.AddResourceFile(%A, %A, enum %d)" (abs <| hash asmB) nm1 nm2 (LanguagePrimitives.EnumToValue attrs) - asmB.AddResourceFile(nm1,nm2,attrs) + asmB.AddResourceFile(nm1, nm2, attrs) #endif member asmB.SetCustomAttributeAndLog(cab) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A)" (abs <| hash asmB) cab @@ -74,35 +73,33 @@ type System.Reflection.Emit.AssemblyBuilder with type System.Reflection.Emit.ModuleBuilder with - member modB.GetArrayMethodAndLog(aty,nm,flags,rty,tys) = - if logRefEmitCalls then printfn "moduleBuilder%d.GetArrayMethod(%A,%A,%A,%A,%A)" (abs <| hash modB) aty nm flags rty tys - modB.GetArrayMethod(aty,nm,flags,rty,tys) - -#if FX_RESHAPED_REFEMIT -#else - member modB.DefineDocumentAndLog(file,lang,vendor,doctype) = - let symDoc = modB.DefineDocument(file,lang,vendor,doctype) - if logRefEmitCalls then printfn "let docWriter%d = moduleBuilder%d.DefineDocument(@%A,System.Guid(\"%A\"),System.Guid(\"%A\"),System.Guid(\"%A\"))" (abs <| hash symDoc) (abs <| hash modB) file lang vendor doctype + member modB.GetArrayMethodAndLog(aty, nm, flags, rty, tys) = + if logRefEmitCalls then printfn "moduleBuilder%d.GetArrayMethod(%A, %A, %A, %A, %A)" (abs <| hash modB) aty nm flags rty tys + modB.GetArrayMethod(aty, nm, flags, rty, tys) + +#if !FX_RESHAPED_REFEMIT + member modB.DefineDocumentAndLog(file, lang, vendor, doctype) = + let symDoc = modB.DefineDocument(file, lang, vendor, doctype) + if logRefEmitCalls then printfn "let docWriter%d = moduleBuilder%d.DefineDocument(@%A, System.Guid(\"%A\"), System.Guid(\"%A\"), System.Guid(\"%A\"))" (abs <| hash symDoc) (abs <| hash modB) file lang vendor doctype symDoc #endif - member modB.GetTypeAndLog(nameInModule,flag1,flag2) = - if logRefEmitCalls then printfn "moduleBuilder%d.GetType(%A,%A,%A) |> ignore" (abs <| hash modB) nameInModule flag1 flag2 - modB.GetType(nameInModule,flag1,flag2) + member modB.GetTypeAndLog(nameInModule, flag1, flag2) = + if logRefEmitCalls then printfn "moduleBuilder%d.GetType(%A, %A, %A) |> ignore" (abs <| hash modB) nameInModule flag1 flag2 + modB.GetType(nameInModule, flag1, flag2) - member modB.DefineTypeAndLog(name,attrs) = - let typB = modB.DefineType(name,attrs) - if logRefEmitCalls then printfn "let typeBuilder%d = moduleBuilder%d.DefineType(%A,enum %d)" (abs <| hash typB) (abs <| hash modB) name (LanguagePrimitives.EnumToValue attrs) + member modB.DefineTypeAndLog(name, attrs) = + let typB = modB.DefineType(name, attrs) + if logRefEmitCalls then printfn "let typeBuilder%d = moduleBuilder%d.DefineType(%A, enum %d)" (abs <| hash typB) (abs <| hash modB) name (LanguagePrimitives.EnumToValue attrs) typB -#if FX_RESHAPED_REFEMIT -#else - member modB.DefineManifestResourceAndLog(name,stream,attrs) = - if logRefEmitCalls then printfn "moduleBuilder%d.DefineManifestResource(%A,%A,enum %d)" (abs <| hash modB) name stream (LanguagePrimitives.EnumToValue attrs) - modB.DefineManifestResource(name,stream,attrs) +#if !FX_RESHAPED_REFEMIT + member modB.DefineManifestResourceAndLog(name, stream, attrs) = + if logRefEmitCalls then printfn "moduleBuilder%d.DefineManifestResource(%A, %A, enum %d)" (abs <| hash modB) name stream (LanguagePrimitives.EnumToValue attrs) + modB.DefineManifestResource(name, stream, attrs) #endif - member modB.SetCustomAttributeAndLog(cinfo,bytes) = + member modB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "moduleBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash modB) cinfo bytes - wrapCustomAttr modB.SetCustomAttribute (cinfo,bytes) + wrapCustomAttr modB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.ConstructorBuilder with @@ -110,9 +107,9 @@ type System.Reflection.Emit.ConstructorBuilder with if logRefEmitCalls then printfn "constructorBuilder%d.SetImplementationFlags(enum %d)" (abs <| hash consB) (LanguagePrimitives.EnumToValue attrs) consB.SetImplementationFlags(attrs) - member consB.DefineParameterAndLog(n,attr,nm) = - if logRefEmitCalls then printfn "constructorBuilder%d.DefineParameter(%d,enum %d,%A)" (abs <| hash consB) n (LanguagePrimitives.EnumToValue attr) nm - consB.DefineParameter(n,attr,nm) + member consB.DefineParameterAndLog(n, attr, nm) = + if logRefEmitCalls then printfn "constructorBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash consB) n (LanguagePrimitives.EnumToValue attr) nm + consB.DefineParameter(n, attr, nm) member consB.GetILGeneratorAndLog() = let ilG = consB.GetILGenerator() @@ -132,9 +129,9 @@ type System.Reflection.Emit.MethodBuilder with if logRefEmitCalls then printfn "methodBuilder%d.SetParameters(%A)" (abs <| hash methB) ps methB.SetParameters(ps) - member methB.DefineParameterAndLog(n,attr,nm) = - if logRefEmitCalls then printfn "methodBuilder%d.DefineParameter(%d,enum %d,%A)" (abs <| hash methB) n (LanguagePrimitives.EnumToValue attr) nm - methB.DefineParameter(n,attr,nm) + member methB.DefineParameterAndLog(n, attr, nm) = + if logRefEmitCalls then printfn "methodBuilder%d.DefineParameter(%d, enum %d, %A)" (abs <| hash methB) n (LanguagePrimitives.EnumToValue attr) nm + methB.DefineParameter(n, attr, nm) member methB.DefineGenericParametersAndLog(gps) = if logRefEmitCalls then printfn "let gps%d = methodBuilder%d.DefineGenericParameters(%A)" (abs <| hash methB) (abs <| hash methB) gps @@ -145,9 +142,9 @@ type System.Reflection.Emit.MethodBuilder with if logRefEmitCalls then printfn "let ilg%d = methodBuilder%d.GetILGenerator()" (abs <| hash ilG) (abs <| hash methB) ilG - member methB.SetCustomAttributeAndLog(cinfo,bytes) = + member methB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "methodBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash methB) cinfo bytes - wrapCustomAttr methB.SetCustomAttribute (cinfo,bytes) + wrapCustomAttr methB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.TypeBuilder with member typB.CreateTypeAndLog() = @@ -157,37 +154,37 @@ type System.Reflection.Emit.TypeBuilder with #else typB.CreateType() #endif - member typB.DefineNestedTypeAndLog(name,attrs) = - let res = typB.DefineNestedType(name,attrs) - if logRefEmitCalls then printfn "let typeBuilder%d = typeBuilder%d.DefineNestedType(\"%s\",enum %d)" (abs <| hash res) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) + member typB.DefineNestedTypeAndLog(name, attrs) = + let res = typB.DefineNestedType(name, attrs) + if logRefEmitCalls then printfn "let typeBuilder%d = typeBuilder%d.DefineNestedType(\"%s\", enum %d)" (abs <| hash res) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) res - member typB.DefineMethodAndLog(name,attrs,cconv) = - let methB = typB.DefineMethod(name,attrs,cconv) - if logRefEmitCalls then printfn "let methodBuilder%d = typeBuilder%d.DefineMethod(\"%s\",enum %d,enum %d)" (abs <| hash methB) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) (LanguagePrimitives.EnumToValue cconv) + member typB.DefineMethodAndLog(name, attrs, cconv) = + let methB = typB.DefineMethod(name, attrs, cconv) + if logRefEmitCalls then printfn "let methodBuilder%d = typeBuilder%d.DefineMethod(\"%s\", enum %d, enum %d)" (abs <| hash methB) (abs <| hash typB) name (LanguagePrimitives.EnumToValue attrs) (LanguagePrimitives.EnumToValue cconv) methB member typB.DefineGenericParametersAndLog(gps) = if logRefEmitCalls then printfn "typeBuilder%d.DefineGenericParameters(%A)" (abs <| hash typB) gps typB.DefineGenericParameters(gps) - member typB.DefineConstructorAndLog(attrs,cconv,parms) = - let consB = typB.DefineConstructor(attrs,cconv,parms) - if logRefEmitCalls then printfn "let constructorBuilder%d = typeBuilder%d.DefineConstructor(enum %d,CallingConventions.%A,%A)" (abs <| hash consB) (abs <| hash typB) (LanguagePrimitives.EnumToValue attrs) cconv parms + member typB.DefineConstructorAndLog(attrs, cconv, parms) = + let consB = typB.DefineConstructor(attrs, cconv, parms) + if logRefEmitCalls then printfn "let constructorBuilder%d = typeBuilder%d.DefineConstructor(enum %d, CallingConventions.%A, %A)" (abs <| hash consB) (abs <| hash typB) (LanguagePrimitives.EnumToValue attrs) cconv parms consB - member typB.DefineFieldAndLog(nm,ty:System.Type,attrs) = - let fieldB = typB.DefineField(nm,ty,attrs) - if logRefEmitCalls then printfn "let fieldBuilder%d = typeBuilder%d.DefineField(\"%s\",typeof<%s>,enum %d)" (abs <| hash fieldB) (abs <| hash typB) nm ty.FullName (LanguagePrimitives.EnumToValue attrs) + member typB.DefineFieldAndLog(nm, ty:System.Type, attrs) = + let fieldB = typB.DefineField(nm, ty, attrs) + if logRefEmitCalls then printfn "let fieldBuilder%d = typeBuilder%d.DefineField(\"%s\", typeof<%s>, enum %d)" (abs <| hash fieldB) (abs <| hash typB) nm ty.FullName (LanguagePrimitives.EnumToValue attrs) fieldB - member typB.DefinePropertyAndLog(nm,attrs,ty:System.Type,args) = - if logRefEmitCalls then printfn "typeBuilder%d.DefineProperty(\"%A\",enum %d,typeof<%s>,%A)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName args - typB.DefineProperty(nm,attrs,ty,args) + member typB.DefinePropertyAndLog(nm, attrs, ty:System.Type, args) = + if logRefEmitCalls then printfn "typeBuilder%d.DefineProperty(\"%A\", enum %d, typeof<%s>, %A)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName args + typB.DefineProperty(nm, attrs, ty, args) - member typB.DefineEventAndLog(nm,attrs,ty:System.Type) = - if logRefEmitCalls then printfn "typeBuilder%d.DefineEvent(\"%A\",enum %d,typeof<%A>)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName - typB.DefineEvent(nm,attrs,ty) + member typB.DefineEventAndLog(nm, attrs, ty:System.Type) = + if logRefEmitCalls then printfn "typeBuilder%d.DefineEvent(\"%A\", enum %d, typeof<%A>)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue attrs) ty.FullName + typB.DefineEvent(nm, attrs, ty) member typB.SetParentAndLog(ty:System.Type) = if logRefEmitCalls then printfn "typeBuilder%d.SetParent(typeof<%s>)" (abs <| hash typB) ty.FullName @@ -197,7 +194,7 @@ type System.Reflection.Emit.TypeBuilder with if logRefEmitCalls then printfn "typeBuilder%d.AddInterfaceImplementation(%A)" (abs <| hash typB) ty typB.AddInterfaceImplementation(ty) - member typB.InvokeMemberAndLog(nm,_flags,args) = + member typB.InvokeMemberAndLog(nm, _flags, args) = #if FX_RESHAPED_REFEMIT let t = typB.CreateTypeAndLog() let m = @@ -206,29 +203,28 @@ type System.Reflection.Emit.TypeBuilder with if m <> null then m.Invoke(null, args) else raise (MissingMethodException(nm)) #else - if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\",enum %d,null,null,%A,Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue _flags) args - typB.InvokeMember(nm,_flags,null,null,args,Globalization.CultureInfo.InvariantCulture) + if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\", enum %d, null, null, %A, Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue _flags) args + typB.InvokeMember(nm, _flags, null, null, args, Globalization.CultureInfo.InvariantCulture) #endif - member typB.SetCustomAttributeAndLog(cinfo,bytes) = + member typB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then printfn "typeBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash typB) cinfo bytes - wrapCustomAttr typB.SetCustomAttribute (cinfo,bytes) + wrapCustomAttr typB.SetCustomAttribute (cinfo, bytes) type System.Reflection.Emit.OpCode with - member opcode.RefEmitName = (string (System.Char.ToUpper(opcode.Name.[0])) + opcode.Name.[1..]).Replace(".","_").Replace("_i4","_I4") + member opcode.RefEmitName = (string (System.Char.ToUpper(opcode.Name.[0])) + opcode.Name.[1..]).Replace(".", "_").Replace("_i4", "_I4") type System.Reflection.Emit.ILGenerator with - member ilG.DeclareLocalAndLog(ty:System.Type,isPinned) = - if logRefEmitCalls then printfn "ilg%d.DeclareLocal(typeof<%s>,%b)" (abs <| hash ilG) ty.FullName isPinned - ilG.DeclareLocal(ty,isPinned) + member ilG.DeclareLocalAndLog(ty:System.Type, isPinned) = + if logRefEmitCalls then printfn "ilg%d.DeclareLocal(typeof<%s>, %b)" (abs <| hash ilG) ty.FullName isPinned + ilG.DeclareLocal(ty, isPinned) member ilG.MarkLabelAndLog(lab) = if logRefEmitCalls then printfn "ilg%d.MarkLabel(label%d_%d)" (abs <| hash ilG) (abs <| hash ilG) (abs <| hash lab) ilG.MarkLabel(lab) -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT member ilG.MarkSequencePointAndLog(symDoc, l1, c1, l2, c2) = if logRefEmitCalls then printfn "ilg%d.MarkSequencePoint(docWriter%d, %A, %A, %A, %A)" (abs <| hash ilG) (abs <| hash symDoc) l1 c1 l2 c2 ilG.MarkSequencePoint(symDoc, l1, c1, l2, c2) @@ -265,30 +261,30 @@ type System.Reflection.Emit.ILGenerator with member x.EmitAndLog (op:OpCode) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s)" (abs <| hash x) op.RefEmitName x.Emit(op) - member x.EmitAndLog (op:OpCode,v:Label) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,label%d_%d)" (abs <| hash x) op.RefEmitName (abs <| hash x) (abs <| hash v); - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:int16) = + member x.EmitAndLog (op:OpCode, v:Label) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, label%d_%d)" (abs <| hash x) op.RefEmitName (abs <| hash x) (abs <| hash v); + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:int16) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, int16 %d)" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:int32) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:int32) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, %d)" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:MethodInfo) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:MethodInfo) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, methodBuilder%d) // method %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:string) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,\"@%s\")" (abs <| hash x) op.RefEmitName v; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:Type) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:string) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, \"@%s\")" (abs <| hash x) op.RefEmitName v; + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:Type) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, typeof<%s>)" (abs <| hash x) op.RefEmitName v.FullName; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:FieldInfo) = + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:FieldInfo) = if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, fieldBuilder%d) // field %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; - x.Emit(op,v) - member x.EmitAndLog (op:OpCode,v:ConstructorInfo) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s,constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name; - x.Emit(op,v) + x.Emit(op, v) + member x.EmitAndLog (op:OpCode, v:ConstructorInfo) = + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name; + x.Emit(op, v) //---------------------------------------------------------------------------- @@ -322,12 +318,11 @@ let convAssemblyRef (aref:ILAssemblyRef) = | None -> () | Some (PublicKey bytes) -> asmName.SetPublicKey(bytes) | Some (PublicKeyToken bytes) -> asmName.SetPublicKeyToken(bytes)); - let setVersion (major,minor,build,rev) = - asmName.Version <- System.Version (int32 major,int32 minor,int32 build, int32 rev) + let setVersion (major, minor, build, rev) = + asmName.Version <- System.Version (int32 major, int32 minor, int32 build, int32 rev) Option.iter setVersion aref.Version; // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL; -#if FX_RESHAPED_GLOBALIZATION -#else +#if !FX_RESHAPED_GLOBALIZATION //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture(name)) aref.Locale; asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture; #endif @@ -338,15 +333,15 @@ type cenv = { ilg: ILGlobals tryFindSysILTypeRef : string -> ILTypeRef option generatePdb: bool - resolveAssemblyRef: (ILAssemblyRef -> Choice option) } + resolveAssemblyRef: (ILAssemblyRef -> Choice option) } /// Convert an Abstract IL type reference to Reflection.Emit System.Type value. // This ought to be an adequate substitute for this whole function, but it needs // to be thoroughly tested. // Type.GetType(tref.QualifiedName) -// [] ,name -> name -// [ns] ,name -> ns+name -// [ns;typeA;typeB],name -> ns+typeA+typeB+name +// [] , name -> name +// [ns] , name -> ns+name +// [ns;typeA;typeB], name -> ns+typeA+typeB+name let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) = let qualifiedName = (String.concat "+" (tref.Enclosing @ [ tref.Name ])).Replace(",", @"\,") match tref.Scope with @@ -377,13 +372,13 @@ let convTypeRefAux (cenv:cenv) (tref:ILTypeRef) = /// and could be placed as hash tables in the global environment. [] type emEnv = - { emTypMap : Zmap ; - emConsMap : Zmap; - emMethMap : Zmap; - emFieldMap : Zmap; - emPropMap : Zmap; + { emTypMap : Zmap ; + emConsMap : Zmap; + emMethMap : Zmap; + emFieldMap : Zmap; + emPropMap : Zmap; emLocals : LocalBuilder[]; - emLabels : Zmap; + emLabels : Zmap; emTyvars : Type[] list; // stack emEntryPts : (TypeBuilder * string) list delayedFieldInits : (unit -> unit) list} @@ -405,16 +400,16 @@ let emEnv0 = emEntryPts = [] delayedFieldInits = [] } -let envBindTypeRef emEnv (tref:ILTypeRef) (typT,typB,typeDef)= +let envBindTypeRef emEnv (tref:ILTypeRef) (typT, typB, typeDef)= match typT with | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name; - | _ -> {emEnv with emTypMap = Zmap.add tref (typT,typB,typeDef,None) emEnv.emTypMap} + | _ -> {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, None) emEnv.emTypMap} let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = // The tref's TypeBuilder has been created, so we have a Type proper. // Update the tables to include this created type (the typT held prior to this is (i think) actually (TypeBuilder :> Type). // The (TypeBuilder :> Type) does not implement all the methods that a Type proper does. - let typT,typB,typeDef,_createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" + let typT, typB, typeDef, _createdTypOpt = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" if typB.IsCreated() then let typ = typB.CreateTypeAndLog() #if ENABLE_MONO_SUPPORT @@ -429,7 +424,7 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = System.Runtime.Serialization.FormatterServices.GetUninitializedObject(typ) |> ignore with e -> () #endif - {emEnv with emTypMap = Zmap.add tref (typT,typB,typeDef,Some typ) emEnv.emTypMap} + {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, Some typ) emEnv.emTypMap} else #if DEBUG printf "envUpdateCreatedTypeRef: expected type to be created\n"; @@ -439,8 +434,8 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = let convTypeRef cenv emEnv preferCreated (tref:ILTypeRef) = let res = match Zmap.tryFind tref emEnv.emTypMap with - | Some (_typT,_typB,_typeDef,Some createdTyp) when preferCreated -> createdTyp - | Some (typT,_typB,_typeDef,_) -> typT + | Some (_typT, _typB, _typeDef, Some createdTyp) when preferCreated -> createdTyp + | Some (typT, _typB, _typeDef, _) -> typT | None -> convTypeRefAux cenv tref match res with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tref.QualifiedName, tref.Scope.QualifiedName), range0)) @@ -472,11 +467,11 @@ let envGetPropB emEnv pref = let envGetTypB emEnv (tref:ILTypeRef) = Zmap.force tref emEnv.emTypMap "envGetTypB: failed" - |> (fun (_typT,typB,_typeDef,_createdTypOpt) -> typB) + |> (fun (_typT, typB, _typeDef, _createdTypOpt) -> typB) let envGetTypeDef emEnv (tref:ILTypeRef) = Zmap.force tref emEnv.emTypMap "envGetTypeDef: failed" - |> (fun (_typT,_typB,typeDef,_createdTypOpt) -> typeDef) + |> (fun (_typT, _typB, typeDef, _createdTypOpt) -> typeDef) let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "locals" is not yet set (scopes once only) {emEnv with emLocals = locs} @@ -504,13 +499,13 @@ let envGetTyvar emEnv u16 = let isEmittedTypeRef emEnv tref = Zmap.mem tref emEnv.emTypMap let envAddEntryPt emEnv mref = {emEnv with emEntryPts = mref::emEnv.emEntryPts} -let envPopEntryPts emEnv = {emEnv with emEntryPts = []},emEnv.emEntryPts +let envPopEntryPts emEnv = {emEnv with emEntryPts = []}, emEnv.emEntryPts //---------------------------------------------------------------------------- // convCallConv //---------------------------------------------------------------------------- -let convCallConv (Callconv (hasThis,basic)) = +let convCallConv (Callconv (hasThis, basic)) = let ccA = match hasThis with ILThisConvention.Static -> CallingConventions.Standard | ILThisConvention.InstanceExplicit -> CallingConventions.ExplicitThis | ILThisConvention.Instance -> CallingConventions.HasThis @@ -531,10 +526,10 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec:ILTypeSpec) = let typT = convTypeRef cenv emEnv preferCreated tspec.TypeRef let tyargs = List.map (convTypeAux cenv emEnv preferCreated) tspec.GenericArgs let res = - match isNil tyargs,typT.IsGenericType with - | _ ,true -> typT.MakeGenericType(List.toArray tyargs) - | true,false -> typT - | _ ,false -> null + match isNil tyargs, typT.IsGenericType with + | _ , true -> typT.MakeGenericType(List.toArray tyargs) + | true, false -> typT + | _ , false -> null match res with | null -> error(Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0)) | _ -> res @@ -542,13 +537,13 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec:ILTypeSpec) = and convTypeAux cenv emEnv preferCreated typ = match typ with | ILType.Void -> Type.GetType("System.Void") - | ILType.Array (shape,eltType) -> + | ILType.Array (shape, eltType) -> let baseT = convTypeAux cenv emEnv preferCreated eltType let nDims = shape.Rank // MakeArrayType() returns "eltType[]" // MakeArrayType(1) returns "eltType[*]" - // MakeArrayType(2) returns "eltType[,]" - // MakeArrayType(3) returns "eltType[,,]" + // MakeArrayType(2) returns "eltType[, ]" + // MakeArrayType(3) returns "eltType[, , ]" // All non-equal. if nDims=1 then baseT.MakeArrayType() @@ -664,7 +659,7 @@ let queryableTypeGetField _emEnv (parentT:Type) (fref: ILFieldRef) = let nonQueryableTypeGetField (parentTI:Type) (fieldInfo : FieldInfo) : FieldInfo = let res = - if parentTI.IsGenericType then TypeBuilder.GetField(parentTI,fieldInfo) + if parentTI.IsGenericType then TypeBuilder.GetField(parentTI, fieldInfo) else fieldInfo match res with | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("field", fieldInfo.Name, parentTI.AssemblyQualifiedName, parentTI.Assembly.FullName), range0)) @@ -745,11 +740,11 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref:ILMethodRef) = // constructs generic type without checking constraints if not (satisfiesAllParameters mrefParameterTypes haveArgTs) then false else - let argTs,resT = + let argTs, resT = let emEnv = envPushTyvars emEnv (Array.append tyargTs mtyargTIs) let argTs = convTypes cenv emEnv mref.ArgTypes let resT = convType cenv emEnv mref.ReturnType - argTs,resT + argTs, resT let haveResT = methInfo.ReturnType (* check for match *) @@ -765,18 +760,18 @@ let queryableTypeGetMethod cenv emEnv parentT (mref:ILMethodRef) = assert(not (typeIsNotQueryable(parentT))) if mref.GenericArity = 0 then let tyargTs = getGenericArgumentsOfType parentT - let argTs,resT = + let argTs, resT = let emEnv = envPushTyvars emEnv tyargTs let argTs = convTypesToArray cenv emEnv mref.ArgTypes let resT = convType cenv emEnv mref.ReturnType - argTs,resT + argTs, resT let stat = mref.CallingConv.IsStatic let cconv = (if stat then BindingFlags.Static else BindingFlags.Instance) let methInfo = try - parentT.GetMethod(mref.Name,cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, - null, - argTs, + parentT.GetMethod(mref.Name, cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, + null, + argTs, #if FX_RESHAPED_REFLECTION (null:obj[])) #else @@ -794,7 +789,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref:ILMethodRef) = let nonQueryableTypeGetMethod (parentTI:Type) (methInfo : MethodInfo) : MethodInfo = if (parentTI.IsGenericType && not (equalTypes parentTI (getTypeConstructor parentTI))) - then TypeBuilder.GetMethod(parentTI,methInfo ) + then TypeBuilder.GetMethod(parentTI, methInfo ) else methInfo let convMethodRef cenv emEnv (parentTI:Type) (mref:ILMethodRef) = @@ -842,14 +837,14 @@ let queryableTypeGetConstructor cenv emEnv (parentT:Type) (mref:ILMethodRef) = let reqArgTs = let emEnv = envPushTyvars emEnv tyargTs convTypesToArray cenv emEnv mref.ArgTypes - let res = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance,null, reqArgTs,null) + let res = parentT.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, null, reqArgTs, null) match res with | null -> error(Error(FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen ("constructor", mref.Name, parentT.FullName, parentT.Assembly.FullName), range0)) | _ -> res let nonQueryableTypeGetConstructor (parentTI:Type) (consInfo : ConstructorInfo) : ConstructorInfo = - if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI,consInfo) else consInfo + if parentTI.IsGenericType then TypeBuilder.GetConstructor(parentTI, consInfo) else consInfo //---------------------------------------------------------------------------- // convConstructorSpec (like convMethodSpec) @@ -889,18 +884,18 @@ let emitLabelMark emEnv (ilG:ILGenerator) (label:ILCodeLabel) = ///Emit comparison instructions. let emitInstrCompare emEnv (ilG:ILGenerator) comp targ = match comp with - | BI_beq -> ilG.EmitAndLog(OpCodes.Beq,envGetLabel emEnv targ) - | BI_bge -> ilG.EmitAndLog(OpCodes.Bge ,envGetLabel emEnv targ) - | BI_bge_un -> ilG.EmitAndLog(OpCodes.Bge_Un ,envGetLabel emEnv targ) - | BI_bgt -> ilG.EmitAndLog(OpCodes.Bgt ,envGetLabel emEnv targ) - | BI_bgt_un -> ilG.EmitAndLog(OpCodes.Bgt_Un ,envGetLabel emEnv targ) - | BI_ble -> ilG.EmitAndLog(OpCodes.Ble ,envGetLabel emEnv targ) - | BI_ble_un -> ilG.EmitAndLog(OpCodes.Ble_Un ,envGetLabel emEnv targ) - | BI_blt -> ilG.EmitAndLog(OpCodes.Blt ,envGetLabel emEnv targ) - | BI_blt_un -> ilG.EmitAndLog(OpCodes.Blt_Un ,envGetLabel emEnv targ) - | BI_bne_un -> ilG.EmitAndLog(OpCodes.Bne_Un ,envGetLabel emEnv targ) - | BI_brfalse -> ilG.EmitAndLog(OpCodes.Brfalse,envGetLabel emEnv targ) - | BI_brtrue -> ilG.EmitAndLog(OpCodes.Brtrue ,envGetLabel emEnv targ) + | BI_beq -> ilG.EmitAndLog(OpCodes.Beq, envGetLabel emEnv targ) + | BI_bge -> ilG.EmitAndLog(OpCodes.Bge , envGetLabel emEnv targ) + | BI_bge_un -> ilG.EmitAndLog(OpCodes.Bge_Un , envGetLabel emEnv targ) + | BI_bgt -> ilG.EmitAndLog(OpCodes.Bgt , envGetLabel emEnv targ) + | BI_bgt_un -> ilG.EmitAndLog(OpCodes.Bgt_Un , envGetLabel emEnv targ) + | BI_ble -> ilG.EmitAndLog(OpCodes.Ble , envGetLabel emEnv targ) + | BI_ble_un -> ilG.EmitAndLog(OpCodes.Ble_Un , envGetLabel emEnv targ) + | BI_blt -> ilG.EmitAndLog(OpCodes.Blt , envGetLabel emEnv targ) + | BI_blt_un -> ilG.EmitAndLog(OpCodes.Blt_Un , envGetLabel emEnv targ) + | BI_bne_un -> ilG.EmitAndLog(OpCodes.Bne_Un , envGetLabel emEnv targ) + | BI_brfalse -> ilG.EmitAndLog(OpCodes.Brfalse, envGetLabel emEnv targ) + | BI_brtrue -> ilG.EmitAndLog(OpCodes.Brtrue , envGetLabel emEnv targ) /// Emit the volatile. prefix @@ -911,9 +906,9 @@ let emitInstrVolatile (ilG:ILGenerator) = function /// Emit the align. prefix let emitInstrAlign (ilG:ILGenerator) = function | Aligned -> () - | Unaligned1 -> ilG.Emit(OpCodes.Unaligned,1L) // note: doc says use "long" overload! - | Unaligned2 -> ilG.Emit(OpCodes.Unaligned,2L) - | Unaligned4 -> ilG.Emit(OpCodes.Unaligned,3L) + | Unaligned1 -> ilG.Emit(OpCodes.Unaligned, 1L) // note: doc says use "long" overload! + | Unaligned2 -> ilG.Emit(OpCodes.Unaligned, 2L) + | Unaligned4 -> ilG.Emit(OpCodes.Unaligned, 3L) /// Emit the tail. prefix if necessary let emitInstrTail (ilG:ILGenerator) tail emitTheCall = @@ -923,7 +918,7 @@ let emitInstrTail (ilG:ILGenerator) tail emitTheCall = let emitInstrNewobj cenv emEnv (ilG:ILGenerator) mspec varargs = match varargs with - | None -> ilG.EmitAndLog(OpCodes.Newobj,convConstructorSpec cenv emEnv mspec) + | None -> ilG.EmitAndLog(OpCodes.Newobj, convConstructorSpec cenv emEnv mspec) | Some _vartyps -> failwith "emit: pending new varargs" // XXX - gap let emitSilverlightCheck (ilG:ILGenerator) = @@ -935,19 +930,19 @@ let emitInstrCall cenv emEnv (ilG:ILGenerator) opCall tail (mspec:ILMethodSpec) if mspec.MethodRef.Name = ".ctor" || mspec.MethodRef.Name = ".cctor" then let cinfo = convConstructorSpec cenv emEnv mspec match varargs with - | None -> ilG.EmitAndLog (opCall,cinfo) + | None -> ilG.EmitAndLog (opCall, cinfo) | Some _vartyps -> failwith "emitInstrCall: .ctor and varargs" else let minfo = convMethodSpec cenv emEnv mspec match varargs with - | None -> ilG.EmitAndLog(opCall,minfo) - | Some vartyps -> ilG.EmitCall (opCall,minfo,convTypesToArray cenv emEnv vartyps) + | None -> ilG.EmitAndLog(opCall, minfo) + | Some vartyps -> ilG.EmitCall (opCall, minfo, convTypesToArray cenv emEnv vartyps) ) let getGenericMethodDefinition q (ty:Type) = let gminfo = match q with - | Quotations.Patterns.Call(_,minfo,_) -> minfo.GetGenericMethodDefinition() + | Quotations.Patterns.Call(_, minfo, _) -> minfo.GetGenericMethodDefinition() | _ -> failwith "unexpected failure decoding quotation at ilreflect startup" gminfo.MakeGenericMethod [| ty |] @@ -983,57 +978,57 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | AI_cgt_un -> ilG.EmitAndLog(OpCodes.Cgt_Un) | AI_clt -> ilG.EmitAndLog(OpCodes.Clt) | AI_clt_un -> ilG.EmitAndLog(OpCodes.Clt_Un) - (* conversion *) - | AI_conv dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_U8) - | DT_R -> ilG.EmitAndLog(OpCodes.Conv_R_Un) - | DT_R4 -> ilG.EmitAndLog(OpCodes.Conv_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Conv_R8) - | DT_REF -> failwith "AI_conv DT_REF?" // XXX - check - ) - (* conversion - ovf checks *) - | AI_conv_ovf dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8) - | DT_R -> failwith "AI_conv_ovf DT_R?" // XXX - check - | DT_R4 -> failwith "AI_conv_ovf DT_R4?" // XXX - check - | DT_R8 -> failwith "AI_conv_ovf DT_R8?" // XXX - check - | DT_REF -> failwith "AI_conv_ovf DT_REF?" // XXX - check - ) - (* conversion - ovf checks and unsigned *) - | AI_conv_ovf_un dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I_Un) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1_Un) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2_Un) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4_Un) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8_Un) - | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U_Un) - | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1_Un) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2_Un) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4_Un) - | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8_Un) - | DT_R -> failwith "AI_conv_ovf_un DT_R?" // XXX - check - | DT_R4 -> failwith "AI_conv_ovf_un DT_R4?" // XXX - check - | DT_R8 -> failwith "AI_conv_ovf_un DT_R8?" // XXX - check - | DT_REF -> failwith "AI_conv_ovf_un DT_REF?" // XXX - check - ) + // conversion + | AI_conv dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Conv_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_I8) + | DT_U -> ilG.EmitAndLog(OpCodes.Conv_U) + | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_U4) + | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_U8) + | DT_R -> ilG.EmitAndLog(OpCodes.Conv_R_Un) + | DT_R4 -> ilG.EmitAndLog(OpCodes.Conv_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Conv_R8) + | DT_REF -> failwith "AI_conv DT_REF?" // XXX - check + // conversion - ovf checks + | AI_conv_ovf dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8) + | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U) + | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4) + | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8) + | DT_R -> failwith "AI_conv_ovf DT_R?" // XXX - check + | DT_R4 -> failwith "AI_conv_ovf DT_R4?" // XXX - check + | DT_R8 -> failwith "AI_conv_ovf DT_R8?" // XXX - check + | DT_REF -> failwith "AI_conv_ovf DT_REF?" // XXX - check + // conversion - ovf checks and unsigned + | AI_conv_ovf_un dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I_Un) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I1_Un) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I2_Un) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I4_Un) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_I8_Un) + | DT_U -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U_Un) + | DT_U1 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U1_Un) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U2_Un) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U4_Un) + | DT_U8 -> ilG.EmitAndLog(OpCodes.Conv_Ovf_U8_Un) + | DT_R -> failwith "AI_conv_ovf_un DT_R?" // XXX - check + | DT_R4 -> failwith "AI_conv_ovf_un DT_R4?" // XXX - check + | DT_R8 -> failwith "AI_conv_ovf_un DT_R8?" // XXX - check + | DT_REF -> failwith "AI_conv_ovf_un DT_REF?" // XXX - check | AI_mul -> ilG.EmitAndLog(OpCodes.Mul) | AI_mul_ovf -> ilG.EmitAndLog(OpCodes.Mul_Ovf) | AI_mul_ovf_un -> ilG.EmitAndLog(OpCodes.Mul_Ovf_Un) @@ -1054,158 +1049,198 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | AI_pop -> ilG.EmitAndLog(OpCodes.Pop) | AI_ckfinite -> ilG.EmitAndLog(OpCodes.Ckfinite) | AI_nop -> ilG.EmitAndLog(OpCodes.Nop) - | AI_ldc (DT_I4,ILConst.I4 i32) -> ilG.EmitAndLog(OpCodes.Ldc_I4,i32) - | AI_ldc (DT_I8,ILConst.I8 i64) -> ilG.Emit(OpCodes.Ldc_I8,i64) - | AI_ldc (DT_R4,ILConst.R4 r32) -> ilG.Emit(OpCodes.Ldc_R4,r32) - | AI_ldc (DT_R8,ILConst.R8 r64) -> ilG.Emit(OpCodes.Ldc_R8,r64) - | AI_ldc (_ ,_ ) -> failwith "emitInstrI_arith (AI_ldc (typ,const)) iltyped" - | I_ldarg u16 -> ilG.EmitAndLog(OpCodes.Ldarg ,int16 u16) - | I_ldarga u16 -> ilG.EmitAndLog(OpCodes.Ldarga,int16 u16) - | I_ldind (align,vol,dt) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Ldind_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldind_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldind_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldind_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldind_I8) - | DT_R -> failwith "emitInstr cenv: ldind R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldind_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldind_R8) - | DT_U -> failwith "emitInstr cenv: ldind U" - | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldind_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldind_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldind_U4) - | DT_U8 -> failwith "emitInstr cenv: ldind U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref)) - | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc ,int16 u16) - | I_ldloca u16 -> ilG.EmitAndLog(OpCodes.Ldloca,int16 u16) - | I_starg u16 -> ilG.EmitAndLog(OpCodes.Starg ,int16 u16) - | I_stind (align,vol,dt) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Stind_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Stind_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Stind_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Stind_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Stind_I8) - | DT_R -> failwith "emitInstr cenv: stind R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Stind_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Stind_R8) - | DT_U -> ilG.EmitAndLog(OpCodes.Stind_I) // NOTE: unsigned -> int conversion - | DT_U1 -> ilG.EmitAndLog(OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs - | DT_U2 -> ilG.EmitAndLog(OpCodes.Stind_I2) // NOTE: is it ok? - | DT_U4 -> ilG.EmitAndLog(OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests - | DT_U8 -> ilG.EmitAndLog(OpCodes.Stind_I8) // NOTE: unsigned -> int conversion - | DT_REF -> ilG.EmitAndLog(OpCodes.Stind_Ref)) - | I_stloc u16 -> ilG.EmitAndLog(OpCodes.Stloc,int16 u16) - | I_br targ -> ilG.EmitAndLog(OpCodes.Br,envGetLabel emEnv targ) - | I_jmp mspec -> ilG.EmitAndLog(OpCodes.Jmp,convMethodSpec cenv emEnv mspec) - | I_brcmp (comp,targ) -> emitInstrCompare emEnv ilG comp targ - | I_switch labels -> ilG.Emit(OpCodes.Switch,Array.ofList (List.map (envGetLabel emEnv) labels)); - | I_ret -> ilG.EmitAndLog(OpCodes.Ret) - | I_call (tail,mspec,varargs) -> emitSilverlightCheck ilG - emitInstrCall cenv emEnv ilG OpCodes.Call tail mspec varargs - | I_callvirt (tail,mspec,varargs) -> emitSilverlightCheck ilG - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_callconstraint (tail,typ,mspec,varargs) -> ilG.Emit(OpCodes.Constrained,convType cenv emEnv typ); - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_calli (tail,callsig,None) -> emitInstrTail ilG tail (fun () -> - ilG.EmitCalli(OpCodes.Calli, - convCallConv callsig.CallingConv, - convType cenv emEnv callsig.ReturnType, - convTypesToArray cenv emEnv callsig.ArgTypes, - Unchecked.defaultof)) - | I_calli (tail,callsig,Some vartyps) -> emitInstrTail ilG tail (fun () -> - ilG.EmitCalli(OpCodes.Calli, - convCallConv callsig.CallingConv, - convType cenv emEnv callsig.ReturnType, - convTypesToArray cenv emEnv callsig.ArgTypes, - convTypesToArray cenv emEnv vartyps)) - | I_ldftn mspec -> ilG.EmitAndLog(OpCodes.Ldftn,convMethodSpec cenv emEnv mspec) - | I_newobj (mspec,varargs) -> emitInstrNewobj cenv emEnv ilG mspec varargs + | AI_ldc (DT_I4, ILConst.I4 i32) -> ilG.EmitAndLog(OpCodes.Ldc_I4, i32) + | AI_ldc (DT_I8, ILConst.I8 i64) -> ilG.Emit(OpCodes.Ldc_I8, i64) + | AI_ldc (DT_R4, ILConst.R4 r32) -> ilG.Emit(OpCodes.Ldc_R4, r32) + | AI_ldc (DT_R8, ILConst.R8 r64) -> ilG.Emit(OpCodes.Ldc_R8, r64) + | AI_ldc (_ , _ ) -> failwith "emitInstrI_arith (AI_ldc (typ, const)) iltyped" + | I_ldarg u16 -> ilG.EmitAndLog(OpCodes.Ldarg , int16 u16) + | I_ldarga u16 -> ilG.EmitAndLog(OpCodes.Ldarga, int16 u16) + | I_ldind (align, vol, dt) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Ldind_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldind_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldind_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldind_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldind_I8) + | DT_R -> failwith "emitInstr cenv: ldind R" + | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldind_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldind_R8) + | DT_U -> failwith "emitInstr cenv: ldind U" + | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldind_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldind_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldind_U4) + | DT_U8 -> failwith "emitInstr cenv: ldind U8" + | DT_REF -> ilG.EmitAndLog(OpCodes.Ldind_Ref) + | I_ldloc u16 -> ilG.EmitAndLog(OpCodes.Ldloc , int16 u16) + | I_ldloca u16 -> ilG.EmitAndLog(OpCodes.Ldloca, int16 u16) + | I_starg u16 -> ilG.EmitAndLog(OpCodes.Starg , int16 u16) + | I_stind (align, vol, dt) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Stind_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Stind_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Stind_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Stind_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Stind_I8) + | DT_R -> failwith "emitInstr cenv: stind R" + | DT_R4 -> ilG.EmitAndLog(OpCodes.Stind_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Stind_R8) + | DT_U -> ilG.EmitAndLog(OpCodes.Stind_I) // NOTE: unsigned -> int conversion + | DT_U1 -> ilG.EmitAndLog(OpCodes.Stind_I1) // NOTE: follows code ilwrite.fs + | DT_U2 -> ilG.EmitAndLog(OpCodes.Stind_I2) // NOTE: is it ok? + | DT_U4 -> ilG.EmitAndLog(OpCodes.Stind_I4) // NOTE: it is generated by bytearray tests + | DT_U8 -> ilG.EmitAndLog(OpCodes.Stind_I8) // NOTE: unsigned -> int conversion + | DT_REF -> ilG.EmitAndLog(OpCodes.Stind_Ref) + | I_stloc u16 -> ilG.EmitAndLog(OpCodes.Stloc, int16 u16) + | I_br targ -> ilG.EmitAndLog(OpCodes.Br, envGetLabel emEnv targ) + | I_jmp mspec -> ilG.EmitAndLog(OpCodes.Jmp, convMethodSpec cenv emEnv mspec) + | I_brcmp (comp, targ) -> emitInstrCompare emEnv ilG comp targ + | I_switch labels -> ilG.Emit(OpCodes.Switch, Array.ofList (List.map (envGetLabel emEnv) labels)); + | I_ret -> ilG.EmitAndLog(OpCodes.Ret) + + | I_call (tail, mspec, varargs) -> + emitSilverlightCheck ilG + emitInstrCall cenv emEnv ilG OpCodes.Call tail mspec varargs + + | I_callvirt (tail, mspec, varargs) -> + emitSilverlightCheck ilG + emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + + | I_callconstraint (tail, typ, mspec, varargs) -> + ilG.Emit(OpCodes.Constrained, convType cenv emEnv typ); + emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + + | I_calli (tail, callsig, None) -> + emitInstrTail ilG tail (fun () -> + ilG.EmitCalli(OpCodes.Calli, + convCallConv callsig.CallingConv, + convType cenv emEnv callsig.ReturnType, + convTypesToArray cenv emEnv callsig.ArgTypes, + Unchecked.defaultof)) + + | I_calli (tail, callsig, Some vartyps) -> + emitInstrTail ilG tail (fun () -> + ilG.EmitCalli(OpCodes.Calli, + convCallConv callsig.CallingConv, + convType cenv emEnv callsig.ReturnType, + convTypesToArray cenv emEnv callsig.ArgTypes, + convTypesToArray cenv emEnv vartyps)) + + | I_ldftn mspec -> + ilG.EmitAndLog(OpCodes.Ldftn, convMethodSpec cenv emEnv mspec) + + | I_newobj (mspec, varargs) -> + emitInstrNewobj cenv emEnv ilG mspec varargs + | I_throw -> ilG.EmitAndLog(OpCodes.Throw) | I_endfinally -> ilG.EmitAndLog(OpCodes.Endfinally) | I_endfilter -> ilG.EmitAndLog(OpCodes.Endfilter) - | I_leave label -> ilG.EmitAndLog(OpCodes.Leave,envGetLabel emEnv label) - | I_ldsfld (vol,fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldsfld ,convFieldSpec cenv emEnv fspec) - | I_ldfld (align,vol,fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldfld ,convFieldSpec cenv emEnv fspec) - | I_ldsflda fspec -> ilG.EmitAndLog(OpCodes.Ldsflda,convFieldSpec cenv emEnv fspec) - | I_ldflda fspec -> ilG.EmitAndLog(OpCodes.Ldflda ,convFieldSpec cenv emEnv fspec) - | I_stsfld (vol,fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stsfld ,convFieldSpec cenv emEnv fspec) - | I_stfld (align,vol,fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stfld ,convFieldSpec cenv emEnv fspec) - | I_ldstr s -> ilG.EmitAndLog(OpCodes.Ldstr ,s) - | I_isinst typ -> ilG.EmitAndLog(OpCodes.Isinst ,convType cenv emEnv typ) - | I_castclass typ -> ilG.EmitAndLog(OpCodes.Castclass,convType cenv emEnv typ) - | I_ldtoken (ILToken.ILType typ) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convTypeOrTypeDef cenv emEnv typ) - | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convMethodSpec cenv emEnv mspec) - | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog(OpCodes.Ldtoken ,convFieldSpec cenv emEnv fspec) - | I_ldvirtftn mspec -> ilG.EmitAndLog(OpCodes.Ldvirtftn,convMethodSpec cenv emEnv mspec) - (* Value type instructions *) - | I_cpobj typ -> ilG.EmitAndLog(OpCodes.Cpobj ,convType cenv emEnv typ) - | I_initobj typ -> ilG.EmitAndLog(OpCodes.Initobj ,convType cenv emEnv typ) - | I_ldobj (align,vol,typ) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldobj ,convType cenv emEnv typ) - | I_stobj (align,vol,typ) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Stobj ,convType cenv emEnv typ) - | I_box typ -> ilG.EmitAndLog(OpCodes.Box ,convType cenv emEnv typ) - | I_unbox typ -> ilG.EmitAndLog(OpCodes.Unbox ,convType cenv emEnv typ) - | I_unbox_any typ -> ilG.EmitAndLog(OpCodes.Unbox_Any,convType cenv emEnv typ) - | I_sizeof typ -> ilG.EmitAndLog(OpCodes.Sizeof ,convType cenv emEnv typ) + | I_leave label -> ilG.EmitAndLog(OpCodes.Leave, envGetLabel emEnv label) + | I_ldsfld (vol, fspec) -> emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldsfld , convFieldSpec cenv emEnv fspec) + | I_ldfld (align, vol, fspec) -> emitInstrAlign ilG align; emitInstrVolatile ilG vol; ilG.EmitAndLog(OpCodes.Ldfld , convFieldSpec cenv emEnv fspec) + | I_ldsflda fspec -> ilG.EmitAndLog(OpCodes.Ldsflda, convFieldSpec cenv emEnv fspec) + | I_ldflda fspec -> ilG.EmitAndLog(OpCodes.Ldflda , convFieldSpec cenv emEnv fspec) + + | I_stsfld (vol, fspec) -> + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Stsfld, convFieldSpec cenv emEnv fspec) + + | I_stfld (align, vol, fspec) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol; + ilG.EmitAndLog(OpCodes.Stfld, convFieldSpec cenv emEnv fspec) + + | I_ldstr s -> ilG.EmitAndLog(OpCodes.Ldstr, s) + | I_isinst typ -> ilG.EmitAndLog(OpCodes.Isinst, convType cenv emEnv typ) + | I_castclass typ -> ilG.EmitAndLog(OpCodes.Castclass, convType cenv emEnv typ) + | I_ldtoken (ILToken.ILType typ) -> ilG.EmitAndLog(OpCodes.Ldtoken, convTypeOrTypeDef cenv emEnv typ) + | I_ldtoken (ILToken.ILMethod mspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convMethodSpec cenv emEnv mspec) + | I_ldtoken (ILToken.ILField fspec) -> ilG.EmitAndLog(OpCodes.Ldtoken, convFieldSpec cenv emEnv fspec) + | I_ldvirtftn mspec -> ilG.EmitAndLog(OpCodes.Ldvirtftn, convMethodSpec cenv emEnv mspec) + // Value type instructions + | I_cpobj typ -> ilG.EmitAndLog(OpCodes.Cpobj , convType cenv emEnv typ) + | I_initobj typ -> ilG.EmitAndLog(OpCodes.Initobj , convType cenv emEnv typ) + + | I_ldobj (align, vol, typ) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Ldobj , convType cenv emEnv typ) + + | I_stobj (align, vol, typ) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Stobj , convType cenv emEnv typ) + + | I_box typ -> ilG.EmitAndLog(OpCodes.Box , convType cenv emEnv typ) + | I_unbox typ -> ilG.EmitAndLog(OpCodes.Unbox , convType cenv emEnv typ) + | I_unbox_any typ -> ilG.EmitAndLog(OpCodes.Unbox_Any, convType cenv emEnv typ) + | I_sizeof typ -> ilG.EmitAndLog(OpCodes.Sizeof , convType cenv emEnv typ) + // Generalized array instructions. // In AbsIL these instructions include // both the single-dimensional variants (with ILArrayShape == ILArrayShape.SingleDimensional) // and calls to the "special" multi-dimensional "methods" such as - // newobj void string[,]::.ctor(int32, int32) - // call string string[,]::Get(int32, int32) - // call string& string[,]::Address(int32, int32) - // call void string[,]::Set(int32, int32,string) + // newobj void string[, ]::.ctor(int32, int32) + // call string string[, ]::Get(int32, int32) + // call string& string[, ]::Address(int32, int32) + // call void string[, ]::Set(int32, int32, string) // The IL reader transforms calls of this form to the corresponding // generalized instruction with the corresponding ILArrayShape // argument. This is done to simplify the IL and make it more uniform. // The IL writer then reverses this when emitting the binary. - | I_ldelem dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Ldelem_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldelem_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldelem_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldelem_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldelem_I8) - | DT_R -> failwith "emitInstr cenv: ldelem R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldelem_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldelem_R8) - | DT_U -> failwith "emitInstr cenv: ldelem U" - | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldelem_U1) - | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldelem_U2) - | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldelem_U4) - | DT_U8 -> failwith "emitInstr cenv: ldelem U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Ldelem_Ref)) - | I_stelem dt -> (match dt with - | DT_I -> ilG.EmitAndLog(OpCodes.Stelem_I) - | DT_I1 -> ilG.EmitAndLog(OpCodes.Stelem_I1) - | DT_I2 -> ilG.EmitAndLog(OpCodes.Stelem_I2) - | DT_I4 -> ilG.EmitAndLog(OpCodes.Stelem_I4) - | DT_I8 -> ilG.EmitAndLog(OpCodes.Stelem_I8) - | DT_R -> failwith "emitInstr cenv: stelem R" - | DT_R4 -> ilG.EmitAndLog(OpCodes.Stelem_R4) - | DT_R8 -> ilG.EmitAndLog(OpCodes.Stelem_R8) - | DT_U -> failwith "emitInstr cenv: stelem U" - | DT_U1 -> failwith "emitInstr cenv: stelem U1" - | DT_U2 -> failwith "emitInstr cenv: stelem U2" - | DT_U4 -> failwith "emitInstr cenv: stelem U4" - | DT_U8 -> failwith "emitInstr cenv: stelem U8" - | DT_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref)) - | I_ldelema (ro,_isNativePtr,shape,typ) -> + | I_ldelem dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Ldelem_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Ldelem_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Ldelem_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Ldelem_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Ldelem_I8) + | DT_R -> failwith "emitInstr cenv: ldelem R" + | DT_R4 -> ilG.EmitAndLog(OpCodes.Ldelem_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Ldelem_R8) + | DT_U -> failwith "emitInstr cenv: ldelem U" + | DT_U1 -> ilG.EmitAndLog(OpCodes.Ldelem_U1) + | DT_U2 -> ilG.EmitAndLog(OpCodes.Ldelem_U2) + | DT_U4 -> ilG.EmitAndLog(OpCodes.Ldelem_U4) + | DT_U8 -> failwith "emitInstr cenv: ldelem U8" + | DT_REF -> ilG.EmitAndLog(OpCodes.Ldelem_Ref) + + | I_stelem dt -> + match dt with + | DT_I -> ilG.EmitAndLog(OpCodes.Stelem_I) + | DT_I1 -> ilG.EmitAndLog(OpCodes.Stelem_I1) + | DT_I2 -> ilG.EmitAndLog(OpCodes.Stelem_I2) + | DT_I4 -> ilG.EmitAndLog(OpCodes.Stelem_I4) + | DT_I8 -> ilG.EmitAndLog(OpCodes.Stelem_I8) + | DT_R -> failwith "emitInstr cenv: stelem R" + | DT_R4 -> ilG.EmitAndLog(OpCodes.Stelem_R4) + | DT_R8 -> ilG.EmitAndLog(OpCodes.Stelem_R8) + | DT_U -> failwith "emitInstr cenv: stelem U" + | DT_U1 -> failwith "emitInstr cenv: stelem U1" + | DT_U2 -> failwith "emitInstr cenv: stelem U2" + | DT_U4 -> failwith "emitInstr cenv: stelem U4" + | DT_U8 -> failwith "emitInstr cenv: stelem U8" + | DT_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref) + + | I_ldelema (ro, _isNativePtr, shape, typ) -> if (ro = ReadonlyAddress) then ilG.EmitAndLog(OpCodes.Readonly); if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Ldelema,convType cenv emEnv typ) + then ilG.EmitAndLog(OpCodes.Ldelema, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) let ety = aty.GetElementType() let rty = ety.MakeByRefType() - let meth = modB.GetArrayMethodAndLog(aty,"Address",System.Reflection.CallingConventions.HasThis,rty,Array.create shape.Rank (typeof) ) - ilG.EmitAndLog(OpCodes.Call,meth) - | I_ldelem_any (shape,typ) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem,convType cenv emEnv typ) + let meth = modB.GetArrayMethodAndLog(aty, "Address", System.Reflection.CallingConventions.HasThis, rty, Array.create shape.Rank (typeof) ) + ilG.EmitAndLog(OpCodes.Call, meth) + + | I_ldelem_any (shape, typ) -> + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelem, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1214,13 +1249,13 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = getArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty,"Get",System.Reflection.CallingConventions.HasThis,ety,Array.create shape.Rank (typeof) ) - ilG.EmitAndLog(OpCodes.Call,meth) + modB.GetArrayMethodAndLog(aty, "Get", System.Reflection.CallingConventions.HasThis, ety, Array.create shape.Rank (typeof) ) + ilG.EmitAndLog(OpCodes.Call, meth) - | I_stelem_any (shape,typ) -> - if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Stelem,convType cenv emEnv typ) + | I_stelem_any (shape, typ) -> + if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Stelem, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) let ety = aty.GetElementType() let meth = #if ENABLE_MONO_SUPPORT @@ -1229,20 +1264,21 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = setArrayMethInfo shape.Rank ety else #endif - modB.GetArrayMethodAndLog(aty,"Set",System.Reflection.CallingConventions.HasThis,(null:Type),Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) - ilG.EmitAndLog(OpCodes.Call,meth) + modB.GetArrayMethodAndLog(aty, "Set", System.Reflection.CallingConventions.HasThis, (null:Type), Array.append (Array.create shape.Rank (typeof)) (Array.ofList [ ety ])) + ilG.EmitAndLog(OpCodes.Call, meth) - | I_newarr (shape,typ) -> + | I_newarr (shape, typ) -> if (shape = ILArrayShape.SingleDimensional) - then ilG.EmitAndLog(OpCodes.Newarr,convType cenv emEnv typ) + then ilG.EmitAndLog(OpCodes.Newarr, convType cenv emEnv typ) else - let aty = convType cenv emEnv (ILType.Array(shape,typ)) - let meth = modB.GetArrayMethodAndLog(aty,".ctor",System.Reflection.CallingConventions.HasThis,(null:Type),Array.create shape.Rank (typeof)) - ilG.EmitAndLog(OpCodes.Newobj,meth) + let aty = convType cenv emEnv (ILType.Array(shape, typ)) + let meth = modB.GetArrayMethodAndLog(aty, ".ctor", System.Reflection.CallingConventions.HasThis, (null:Type), Array.create shape.Rank (typeof)) + ilG.EmitAndLog(OpCodes.Newobj, meth) + | I_ldlen -> ilG.EmitAndLog(OpCodes.Ldlen) - | I_mkrefany typ -> ilG.EmitAndLog(OpCodes.Mkrefany,convType cenv emEnv typ) + | I_mkrefany typ -> ilG.EmitAndLog(OpCodes.Mkrefany, convType cenv emEnv typ) | I_refanytype -> ilG.EmitAndLog(OpCodes.Refanytype) - | I_refanyval typ -> ilG.EmitAndLog(OpCodes.Refanyval,convType cenv emEnv typ) + | I_refanyval typ -> ilG.EmitAndLog(OpCodes.Refanyval, convType cenv emEnv typ) | I_rethrow -> ilG.EmitAndLog(OpCodes.Rethrow) | I_break -> ilG.EmitAndLog(OpCodes.Break) | I_seqpoint src -> @@ -1250,30 +1286,36 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = ignore src () #else - if cenv.generatePdb && not (src.Document.File.EndsWith("stdin",StringComparison.Ordinal)) then + if cenv.generatePdb && not (src.Document.File.EndsWith("stdin", StringComparison.Ordinal)) then let guid x = match x with None -> Guid.Empty | Some g -> Guid(g:byte[]) in let symDoc = modB.DefineDocumentAndLog(src.Document.File, guid src.Document.Language, guid src.Document.Vendor, guid src.Document.DocumentType) ilG.MarkSequencePointAndLog(symDoc, src.Line, src.Column, src.EndLine, src.EndColumn) #endif | I_arglist -> ilG.EmitAndLog(OpCodes.Arglist) | I_localloc -> ilG.EmitAndLog(OpCodes.Localloc) - | I_cpblk (align,vol) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - ilG.EmitAndLog(OpCodes.Cpblk) - | I_initblk (align,vol) -> emitInstrAlign ilG align; - emitInstrVolatile ilG vol; - ilG.EmitAndLog(OpCodes.Initblk) - | EI_ldlen_multi (_,m) -> + + | I_cpblk (align, vol) -> + emitInstrAlign ilG align + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Cpblk) + + | I_initblk (align, vol) -> + emitInstrAlign ilG align; + emitInstrVolatile ilG vol + ilG.EmitAndLog(OpCodes.Initblk) + + | EI_ldlen_multi (_, m) -> emitInstr cenv modB emEnv ilG (mkLdcInt32 m); emitInstr cenv modB emEnv ilG (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [cenv.ilg.typ_Int32], cenv.ilg.typ_Int32))) - | i -> Printf.failwithf "the IL instruction %s cannot be emitted" (i.ToString()) + + | i -> failwithf "the IL instruction %s cannot be emitted" (i.ToString()) let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = // Pre-define the labels pending determining their actual marks let pc2lab = Dictionary() let emEnv = - (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label,pc)) -> + (emEnv, code.Labels) ||> Seq.fold (fun emEnv (KeyValue(label, pc)) -> let lab = ilG.DefineLabelAndLog() pc2lab.[pc] <- (if pc2lab.ContainsKey pc then lab :: pc2lab.[pc] else [lab]) envSetLabel emEnv label lab) @@ -1286,22 +1328,25 @@ let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = pc2action.[pc] <- (if pc2action.ContainsKey pc then pc2action.[pc] @ [ action ] else [ action ]) for e in code.Exceptions do - let (startTry,_endTry) = e.Range + let (startTry, _endTry) = e.Range add startTry (fun () -> ilG.BeginExceptionBlockAndLog() |> ignore) match e.Clause with - | ILExceptionClause.Finally(startHandler,endHandler) -> + | ILExceptionClause.Finally(startHandler, endHandler) -> add startHandler ilG.BeginFinallyBlockAndLog add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.Fault(startHandler,endHandler) -> + + | ILExceptionClause.Fault(startHandler, endHandler) -> add startHandler ilG.BeginFaultBlockAndLog add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.FilterCatch((startFilter,_),(startHandler,endHandler)) -> + + | ILExceptionClause.FilterCatch((startFilter, _), (startHandler, endHandler)) -> add startFilter ilG.BeginExceptFilterBlockAndLog add startHandler (fun () -> ilG.BeginCatchBlockAndLog null) add endHandler ilG.EndExceptionBlockAndLog - | ILExceptionClause.TypeCatch(typ, (startHandler,endHandler)) -> + + | ILExceptionClause.TypeCatch(typ, (startHandler, endHandler)) -> add startHandler (fun () -> ilG.BeginCatchBlockAndLog (convType cenv emEnv typ)) add endHandler ilG.EndExceptionBlockAndLog @@ -1324,8 +1369,7 @@ let emitCode cenv modB emEnv (ilG:ILGenerator) (code: ILCode) = let emitLocal cenv emEnv (ilG : ILGenerator) (local: ILLocal) = let ty = convType cenv emEnv local.Type let locBuilder = ilG.DeclareLocalAndLog(ty, local.IsPinned) -#if FX_NO_PDB_WRITER -#else +#if !FX_NO_PDB_WRITER match local.DebugInfo with | Some(nm, start, finish) -> locBuilder.SetLocalSymInfo(nm, start, finish) | None -> () @@ -1351,7 +1395,7 @@ let convCustomAttr cenv emEnv cattr = | null -> failwithf "convCustomAttr: %+A" cattr.Method | res -> res let data = cattr.Data - (methInfo,data) + (methInfo, data) let emitCustomAttr cenv emEnv add cattr = add (convCustomAttr cenv emEnv cattr) let emitCustomAttrs cenv emEnv add (cattrs : ILAttributes) = List.iter (emitCustomAttr cenv emEnv add) cattrs.AsList @@ -1378,7 +1422,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs : Type array) (gps : ILGenericParam let gpB = genpBs.[i] // the Constraints are either the parent (base) type or interfaces. let constraintTs = convTypes cenv emEnv gp.Constraints - let interfaceTs,baseTs = List.partition (fun (typ:System.Type) -> typ.IsInterface) constraintTs + let interfaceTs, baseTs = List.partition (fun (typ:System.Type) -> typ.IsInterface) constraintTs // set base type constraint (match baseTs with [ ] -> () // Q: should a baseType be set? It is in some samples. Should this be a failure case? @@ -1418,7 +1462,7 @@ let emitParameter cenv emEnv (defineParameter : int * ParameterAttributes * stri | Some name -> name | None -> "X" + string(i+1) - let parB = defineParameter(i,attrs,name) + let parB = defineParameter(i, attrs, name) emitCustomAttrs cenv emEnv (wrapCustomAttr parB.SetCustomAttribute) param.CustomAttrs //---------------------------------------------------------------------------- @@ -1476,7 +1520,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) let attrs = convMethodAttributes mdef let implflags = convMethodImplFlags mdef let cconv = convCallConv mdef.CallingConv - let mref = mkRefToILMethod (tref,mdef) + let mref = mkRefToILMethod (tref, mdef) let emEnv = if mdef.IsEntryPoint && isNil mdef.ParameterTypes then (* Bug 2209: Here, we collect the entry points generated by ilxgen corresponding to the top-level effects. @@ -1484,12 +1528,11 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) However, these user entry points functions must take string[] argument. By only adding entry points with no arguments, we only collect the top-level effects. *) - envAddEntryPt emEnv (typB,mdef.Name) + envAddEntryPt emEnv (typB, mdef.Name) else emEnv match mdef.mdBody.Contents with -#if FX_RESHAPED_REFEMIT -#else +#if !FX_RESHAPED_REFEMIT | MethodBody.PInvoke p -> let argtys = convTypesToArray cenv emEnv mdef.ParameterTypes let rty = convType cenv emEnv mdef.Return.Type @@ -1531,12 +1574,12 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) match mdef.Name with | ".cctor" | ".ctor" -> - let consB = typB.DefineConstructorAndLog(attrs,cconv,convTypesToArray cenv emEnv mdef.ParameterTypes) + let consB = typB.DefineConstructorAndLog(attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) consB.SetImplementationFlagsAndLog(implflags); envBindConsRef emEnv mref consB | _name -> // The return/argument types may involve the generic parameters - let methB = typB.DefineMethodAndLog(mdef.Name,attrs,cconv) + let methB = typB.DefineMethodAndLog(mdef.Name, attrs, cconv) // Method generic type parameters buildGenParamsPass1 emEnv methB.DefineGenericParametersAndLog mdef.GenericParams; @@ -1556,7 +1599,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) //---------------------------------------------------------------------------- let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMethodDef) = - let mref = mkRefToILMethod (tref,mdef) + let mref = mkRefToILMethod (tref, mdef) let isPInvoke = match mdef.mdBody.Contents with | MethodBody.PInvoke _p -> true @@ -1567,7 +1610,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho // Constructors can not have generic parameters assert isNil mdef.GenericParams // Value parameters - let defineParameter (i,attr,name) = consB.DefineParameterAndLog(i+1,attr,name) + let defineParameter (i, attr, name) = consB.DefineParameterAndLog(i+1, attr, name) mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter); // Body emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.mdBody; @@ -1583,11 +1626,11 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho match mdef.Return.CustomAttrs.AsList with | [] -> () | _ -> - let retB = methB.DefineParameterAndLog(0,System.Reflection.ParameterAttributes.Retval,null) + let retB = methB.DefineParameterAndLog(0, System.Reflection.ParameterAttributes.Retval, null) emitCustomAttrs cenv emEnv (wrapCustomAttr retB.SetCustomAttribute) mdef.Return.CustomAttrs // Value parameters - let defineParameter (i,attr,name) = methB.DefineParameterAndLog(i+1,attr,name) + let defineParameter (i, attr, name) = methB.DefineParameterAndLog(i+1, attr, name) mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b); // Body if not isPInvoke then @@ -1622,7 +1665,7 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = match fdef.Data with | Some d -> typB.DefineInitializedData(fdef.Name, d, attrs) | None -> - typB.DefineFieldAndLog(fdef.Name,fieldT,attrs) + typB.DefineFieldAndLog(fdef.Name, fieldT, attrs) // set default value let emEnv = @@ -1644,34 +1687,34 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset)); // custom attributes: done on pass 3 as they may reference attribute constructors generated on // pass 2. - let fref = mkILFieldRef (tref,fdef.Name,fdef.Type) + let fref = mkILFieldRef (tref, fdef.Name, fdef.Type) envBindFieldRef emEnv fref fieldB let buildFieldPass3 cenv tref (_typB:TypeBuilder) emEnv (fdef : ILFieldDef) = - let fref = mkILFieldRef (tref,fdef.Name,fdef.Type) + let fref = mkILFieldRef (tref, fdef.Name, fdef.Type) let fieldB = envGetFieldB emEnv fref emitCustomAttrs cenv emEnv (wrapCustomAttr fieldB.SetCustomAttribute) fdef.CustomAttrs //---------------------------------------------------------------------------- -// buildPropertyPass2,3 +// buildPropertyPass2, 3 //---------------------------------------------------------------------------- let buildPropertyPass2 cenv tref (typB:TypeBuilder) emEnv (prop : ILPropertyDef) = let attrs = flagsIf prop.IsRTSpecialName PropertyAttributes.RTSpecialName ||| flagsIf prop.IsSpecialName PropertyAttributes.SpecialName - let propB = typB.DefinePropertyAndLog(prop.Name,attrs,convType cenv emEnv prop.Type,convTypesToArray cenv emEnv prop.Args) + let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.Type, convTypesToArray cenv emEnv prop.Args) prop.SetMethod |> Option.iter (fun mref -> propB.SetSetMethod(envGetMethB emEnv mref)); prop.GetMethod |> Option.iter (fun mref -> propB.SetGetMethod(envGetMethB emEnv mref)); // set default value prop.Init |> Option.iter (fun initial -> propB.SetConstant(convFieldInit initial)); // custom attributes - let pref = ILPropertyRef.Create (tref,prop.Name) + let pref = ILPropertyRef.Create (tref, prop.Name) envBindPropRef emEnv pref propB let buildPropertyPass3 cenv tref (_typB:TypeBuilder) emEnv (prop : ILPropertyDef) = - let pref = ILPropertyRef.Create (tref,prop.Name) + let pref = ILPropertyRef.Create (tref, prop.Name) let propB = envGetPropB emEnv pref emitCustomAttrs cenv emEnv (wrapCustomAttr propB.SetCustomAttribute) prop.CustomAttrs @@ -1684,7 +1727,7 @@ let buildEventPass3 cenv (typB:TypeBuilder) emEnv (eventDef : ILEventDef) = let attrs = flagsIf eventDef.IsSpecialName EventAttributes.SpecialName ||| flagsIf eventDef.IsRTSpecialName EventAttributes.RTSpecialName assert eventDef.Type.IsSome - let eventB = typB.DefineEventAndLog(eventDef.Name,attrs,convType cenv emEnv eventDef.Type.Value) + let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.Type.Value) eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref)); eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref)); @@ -1698,10 +1741,10 @@ let buildEventPass3 cenv (typB:TypeBuilder) emEnv (eventDef : ILEventDef) = let buildMethodImplsPass3 cenv _tref (typB:TypeBuilder) emEnv (mimpl : IL.ILMethodImplDef) = let bodyMethInfo = convMethodRef cenv emEnv (typB.AsType()) mimpl.OverrideBy.MethodRef // doc: must be MethodBuilder - let (OverridesSpec (mref,dtyp)) = mimpl.Overrides + let (OverridesSpec (mref, dtyp)) = mimpl.Overrides let declMethTI = convType cenv emEnv dtyp let declMethInfo = convMethodRef cenv emEnv declMethTI mref - typB.DefineMethodOverride(bodyMethInfo,declMethInfo); + typB.DefineMethodOverride(bodyMethInfo, declMethInfo); emEnv //---------------------------------------------------------------------------- @@ -1747,14 +1790,14 @@ let typeAttributesOfTypeLayout cenv emEnv x = Some(convCustomAttr cenv emEnv (IL.mkILCustomAttribute cenv.ilg (tref1, - [mkILNonGenericValueTy tref2 ], - [ ILAttribElem.Int32 x ], + [mkILNonGenericValueTy tref2 ], + [ ILAttribElem.Int32 x ], (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 (int32 x)))) @ (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 x)))))) | _ -> None match x with - | ILTypeDefLayout.Auto -> TypeAttributes.AutoLayout,None - | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout,(attr 0x02 p) + | ILTypeDefLayout.Auto -> TypeAttributes.AutoLayout, None + | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout, (attr 0x02 p) | ILTypeDefLayout.Sequential p -> TypeAttributes.SequentialLayout, (attr 0x00 p) @@ -1769,7 +1812,7 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin // TypeAttributes let attrsKind = typeAttrbutesOfTypeDefKind tdef.tdKind let attrsAccess = typeAttrbutesOfTypeAccess tdef.Access - let attrsLayout,cattrsLayout = typeAttributesOfTypeLayout cenv emEnv tdef.Layout + let attrsLayout, cattrsLayout = typeAttributesOfTypeLayout cenv emEnv tdef.Layout let attrsEnc = typeAttributesOfTypeEncoding tdef.Encoding let attrsOther = flagsIf tdef.IsAbstract TypeAttributes.Abstract ||| flagsIf tdef.IsSealed TypeAttributes.Sealed ||| @@ -1780,19 +1823,19 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin let attrsType = attrsKind ||| attrsAccess ||| attrsLayout ||| attrsEnc ||| attrsOther // TypeBuilder from TypeAttributes. - let typB : TypeBuilder = rootTypeBuilder (tdef.Name,attrsType) + let typB : TypeBuilder = rootTypeBuilder (tdef.Name, attrsType) cattrsLayout |> Option.iter typB.SetCustomAttributeAndLog; buildGenParamsPass1 emEnv typB.DefineGenericParametersAndLog tdef.GenericParams; - // bind tref -> (typT,typB) - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + // bind tref -> (typT, typB) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typT = // Q: would it be ok to use typB :> Type ? // Maybe not, recall TypeBuilder maybe subtype of Type, but it is not THE Type. let nameInModule = tref.QualifiedName - modB.GetTypeAndLog(nameInModule,false,false) + modB.GetTypeAndLog(nameInModule, false, false) - let emEnv = envBindTypeRef emEnv tref (typT,typB,tdef) + let emEnv = envBindTypeRef emEnv tref (typT, typB, tdef) // recurse on nested types let nesting = nesting @ [tdef] let buildNestedType emEnv tdef = buildTypeTypeDef cenv emEnv modB typB nesting tdef @@ -1807,7 +1850,7 @@ and buildTypeTypeDef cenv emEnv modB (typB : TypeBuilder) nesting tdef = //---------------------------------------------------------------------------- let rec buildTypeDefPass1b cenv nesting emEnv (tdef : ILTypeDef) = - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let genArgs = getGenericArgumentsOfType (typB.AsType()) let emEnv = envPushTyvars emEnv genArgs @@ -1825,7 +1868,7 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef : ILTypeDef) = //---------------------------------------------------------------------------- let rec buildTypeDefPass2 cenv nesting emEnv (tdef : ILTypeDef) = - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add interface impls @@ -1845,7 +1888,7 @@ let rec buildTypeDefPass2 cenv nesting emEnv (tdef : ILTypeDef) = //---------------------------------------------------------------------------- let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef : ILTypeDef) = - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add method bodies, properties, events @@ -1904,7 +1947,7 @@ let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef : ILTypeDef) = let getEnclosingTypeRefs (tref:ILTypeRef) = match tref.Enclosing with | [] -> [] - | h :: t -> List.scan (fun tr nm -> mkILTyRefInTyRef (tr,nm)) (mkILTyRef(tref.Scope, h)) t + | h :: t -> List.scan (fun tr nm -> mkILTyRefInTyRef (tr, nm)) (mkILTyRef(tref.Scope, h)) t [] type CollectTypes = ValueTypesOnly | All @@ -1916,7 +1959,7 @@ let rec getTypeRefsInType (allTypes: CollectTypes) typ acc = | ILType.TypeVar _ -> acc | ILType.Ptr eltType | ILType.Byref eltType -> getTypeRefsInType allTypes eltType acc - | ILType.Array (_,eltType) -> + | ILType.Array (_, eltType) -> match allTypes with | CollectTypes.ValueTypesOnly -> acc | CollectTypes.All -> getTypeRefsInType allTypes eltType acc @@ -1933,7 +1976,7 @@ let rec getTypeRefsInType (allTypes: CollectTypes) typ acc = let verbose2 = false -let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv tref = +let createTypeRef (visited : Dictionary<_, _>, created : Dictionary<_, _>) emEnv tref = let rec traverseTypeDef (tref:ILTypeRef) (tdef:ILTypeDef) = if verbose2 then dprintf "buildTypeDefPass4: Creating Enclosing Types of %s\n" tdef.Name; @@ -1993,7 +2036,7 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t let typeName = r.Name let typeRef = ILTypeRef.Create(ILScopeRef.Local, nestingToProbe, typeName) match emEnv.emTypMap.TryFind typeRef with - | Some(_,tb,_,_) -> + | Some(_, tb, _, _) -> if not (tb.IsCreated()) then tb.CreateTypeAndLog() |> ignore tb.Assembly @@ -2016,15 +2059,15 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t traverseTypeRef tref -let rec buildTypeDefPass4 (visited,created) nesting emEnv (tdef : ILTypeDef) = +let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef : ILTypeDef) = if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name; - let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting,tdef) - createTypeRef (visited,created) emEnv tref; + let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) + createTypeRef (visited, created) emEnv tref; // nested types let nesting = nesting @ [tdef] - tdef.NestedTypes |> Seq.iter (buildTypeDefPass4 (visited,created) nesting emEnv) + tdef.NestedTypes |> Seq.iter (buildTypeDefPass4 (visited, created) nesting emEnv) //---------------------------------------------------------------------------- // buildModuleType @@ -2055,9 +2098,9 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde let emEnv = { emEnv with delayedFieldInits = [] } let emEnv = (emEnv, tdefs) ||> List.fold (buildModuleTypePass3 cenv modB) - let visited = new Dictionary<_,_>(10) - let created = new Dictionary<_,_>(10) - tdefs |> List.iter (buildModuleTypePass4 (visited,created) emEnv) + let visited = new Dictionary<_, _>(10) + let created = new Dictionary<_, _>(10) + tdefs |> List.iter (buildModuleTypePass4 (visited, created) emEnv) let emEnv = Seq.fold envUpdateCreatedTypeRef emEnv created.Keys // update typT with the created typT emitCustomAttrs cenv emEnv modB.SetCustomAttributeAndLog m.CustomAttrs; #if FX_RESHAPED_REFEMIT @@ -2068,7 +2111,7 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde match r.Location with | ILResourceLocation.Local bf -> modB.DefineManifestResourceAndLog(r.Name, new System.IO.MemoryStream(bf()), attribs) - | ILResourceLocation.File (mr,_) -> + | ILResourceLocation.File (mr, _) -> asmB.AddResourceFileAndLog(r.Name, mr.Name, attribs) | ILResourceLocation.Assembly _ -> failwith "references to resources other assemblies may not be emitted using System.Reflection"); @@ -2078,18 +2121,18 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde //---------------------------------------------------------------------------- // test hook //---------------------------------------------------------------------------- -let defineDynamicAssemblyAndLog(asmName,flags,asmDir:string) = +let defineDynamicAssemblyAndLog(asmName, flags, asmDir:string) = #if FX_NO_APP_DOMAINS - let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName,flags) + let asmB = AssemblyBuilder.DefineDynamicAssembly(asmName, flags) #else let currentDom = System.AppDomain.CurrentDomain - let asmB = currentDom.DefineDynamicAssembly(asmName,flags,asmDir) + let asmB = currentDom.DefineDynamicAssembly(asmName, flags, asmDir) #endif if logRefEmitCalls then printfn "open System" printfn "open System.Reflection" printfn "open System.Reflection.Emit" - printfn "let assemblyBuilder%d = System.AppDomain.CurrentDomain.DefineDynamicAssembly(AssemblyName(Name=\"%s\"),enum %d,%A)" (abs <| hash asmB) asmName.Name (LanguagePrimitives.EnumToValue flags) asmDir + printfn "let assemblyBuilder%d = System.AppDomain.CurrentDomain.DefineDynamicAssembly(AssemblyName(Name=\"%s\"), enum %d, %A)" (abs <| hash asmB) asmName.Name (LanguagePrimitives.EnumToValue flags) asmDir asmB let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) = @@ -2104,15 +2147,15 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) #else else AssemblyBuilderAccess.RunAndSave #endif - let asmB = defineDynamicAssemblyAndLog(asmName,asmAccess,asmDir) + let asmB = defineDynamicAssemblyAndLog(asmName, asmAccess, asmDir) if not optimize then let daType = typeof; let daCtor = daType.GetConstructor [| typeof |] let daBuilder = new CustomAttributeBuilder(daCtor, [| System.Diagnostics.DebuggableAttribute.DebuggingModes.DisableOptimizations ||| System.Diagnostics.DebuggableAttribute.DebuggingModes.Default |]) asmB.SetCustomAttributeAndLog(daBuilder); - let modB = asmB.DefineDynamicModuleAndLog(assemblyName,filename,debugInfo) - asmB,modB + let modB = asmB.DefineDynamicModuleAndLog(assemblyName, filename, debugInfo) + asmB, modB let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolveAssemblyRef, tryFindSysILTypeRef) = let cenv = { ilg = ilg ; generatePdb = debugInfo; resolveAssemblyRef=resolveAssemblyRef; tryFindSysILTypeRef=tryFindSysILTypeRef } @@ -2124,17 +2167,17 @@ let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder // REVIEW: remainder of manifest emitCustomAttrs cenv emEnv asmB.SetCustomAttributeAndLog mani.CustomAttrs; // invoke entry point methods - let execEntryPtFun ((typB : TypeBuilder),methodName) () = + let execEntryPtFun ((typB : TypeBuilder), methodName) () = try - ignore (typB.InvokeMemberAndLog(methodName,BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static,[| |])); + ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])); None with | :? System.Reflection.TargetInvocationException as e -> Some(e.InnerException) - let emEnv,entryPts = envPopEntryPts emEnv + let emEnv, entryPts = envPopEntryPts emEnv let execs = List.map execEntryPtFun entryPts - emEnv,execs + emEnv, execs //---------------------------------------------------------------------------- diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 4751e059e3..81fcf5be8a 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -49,7 +49,7 @@ let dw2 n = byte ((n >>> 16) &&& 0xFFL) let dw1 n = byte ((n >>> 8) &&& 0xFFL) let dw0 n = byte (n &&& 0xFFL) -let bitsOfSingle (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x),0) +let bitsOfSingle (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) let bitsOfDouble (x:float) = System.BitConverter.DoubleToInt64Bits(x) let emitBytesViaBuffer f = let bb = ByteBuffer.Create 10 in f bb; bb.Close() @@ -102,7 +102,7 @@ let getUncodedToken (tab:TableName) idx = ((tab.Index <<< 24) ||| idx) // From ECMA for UserStrings: // This final byte holds the value 1 if and only if any UTF16 character within the string has any bit set in its top byte, or its low byte is any of the following: -// 0x01-0x08, 0x0E-0x1F, 0x27, 0x2D, +// 0x01-0x08, 0x0E-0x1F, 0x27, 0x2D, // 0x7F. Otherwise, it holds 0. The 1 signifies Unicode characters that require handling beyond that normally provided for 8-bit encoding sets. // HOWEVER, there is a discrepancy here between the ECMA spec and the Microsoft C# implementation. @@ -370,13 +370,13 @@ type SharedRow(elems: RowElement[], hashCode: int) = let SharedRow(elems: RowElement[]) = new SharedRow(elems, hashRow elems) /// Special representation : Note, only hashing by name -let AssemblyRefRow(s1,s2,s3,s4,l1,b1,nameIdx,str2,b2) = +let AssemblyRefRow(s1, s2, s3, s4, l1, b1, nameIdx, str2, b2) = let hashCode = hash nameIdx let genericRow = [| UShort s1; UShort s2; UShort s3; UShort s4; ULong l1; Blob b1; StringE nameIdx; StringE str2; Blob b2 |] new SharedRow(genericRow, hashCode) /// Special representation the computes the hash more efficiently -let MemberRefRow(mrp:RowElement,nmIdx:StringIndex,blobIdx:BlobIndex) = +let MemberRefRow(mrp:RowElement, nmIdx:StringIndex, blobIdx:BlobIndex) = let hashCode = combineHash (hash blobIdx) (combineHash (hash nmIdx) (hash mrp)) let genericRow = [| mrp; StringE nmIdx; Blob blobIdx |] new SharedRow(genericRow, hashCode) @@ -423,12 +423,12 @@ type MetadataTable<'T> = mutable rows: ResizeArray<'T> } member x.Count = x.rows.Count - static member New(nm,hashEq) = + static member New(nm, hashEq) = { name=nm #if DEBUG lookups=0 #endif - dict = new Dictionary<_,_>(100, hashEq) + dict = new Dictionary<_, _>(100, hashEq) rows= new ResizeArray<_>() } member tbl.EntriesAsArray = @@ -459,7 +459,7 @@ type MetadataTable<'T> = tbl.lookups <- tbl.lookups + 1 #endif let mutable res = Unchecked.defaultof<_> - let ok = tbl.dict.TryGetValue(x,&res) + let ok = tbl.dict.TryGetValue(x, &res) if ok then res else tbl.AddSharedEntry x @@ -482,7 +482,7 @@ type MetadataTable<'T> = //--------------------------------------------------------------------- /// We use this key type to help find ILMethodDefs for MethodRefs -type MethodDefKey(tidx:int,garity:int,nm:string,rty:ILType,argtys:ILTypes,isStatic:bool) = +type MethodDefKey(tidx:int, garity:int, nm:string, rty:ILType, argtys:ILTypes, isStatic:bool) = // Precompute the hash. The hash doesn't include the return type or // argument types (only argument type count). This is very important, since // hashing these is way too expensive @@ -512,7 +512,7 @@ type MethodDefKey(tidx:int,garity:int,nm:string,rty:ILType,argtys:ILTypes,isStat | _ -> false /// We use this key type to help find ILFieldDefs for FieldRefs -type FieldDefKey(tidx:int,nm:string,ty:ILType) = +type FieldDefKey(tidx:int, nm:string, ty:ILType) = // precompute the hash. hash doesn't include the type let hashCode = hash tidx |> combineHash (hash nm) member key.TypeIdx = tidx @@ -572,14 +572,14 @@ type cenv = mutable entrypoint: (bool * int) option /// Caches - trefCache: Dictionary + trefCache: Dictionary /// The following are all used to generate unique items in the output tables: MetadataTable[] AssemblyRefs: MetadataTable fieldDefs: MetadataTable methodDefIdxsByKey: MetadataTable - methodDefIdxs: Dictionary + methodDefIdxs: Dictionary propertyDefs: MetadataTable eventDefs: MetadataTable typeDefs: MetadataTable @@ -591,7 +591,7 @@ type cenv = member cenv.GetTable (tab:TableName) = cenv.tables.[tab.Index] - member cenv.AddCode ((reqdStringFixupsOffset,requiredStringFixups),code) = + member cenv.AddCode ((reqdStringFixupsOffset, requiredStringFixups), code) = if align 4 cenv.nextCodeAddr <> cenv.nextCodeAddr then dprintn "warning: code not 4-byte aligned" cenv.requiredStringFixups <- (cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups) :: cenv.requiredStringFixups cenv.codeChunks.EmitBytes code @@ -613,17 +613,17 @@ let metadataSchemaVersionSupportedByCLRVersion v = // Later Whidbey versions are post 2.0.40607.0.. However we assume // internal builds such as 2.0.x86chk are Whidbey Beta 2 or later if compareILVersions v (parseILVersion ("2.0.40520.0")) >= 0 && - compareILVersions v (parseILVersion ("2.0.40608.0")) < 0 then 1,1 - elif compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2,0 - else 1,0 + compareILVersions v (parseILVersion ("2.0.40608.0")) < 0 then 1, 1 + elif compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2, 0 + else 1, 0 let headerVersionSupportedByCLRVersion v = // The COM20HEADER version number // Whidbey version numbers are 2.5 // Earlier are 2.0 // From an email from jeffschw: "Be built with a compiler that marks the COM20HEADER with Major >=2 and Minor >= 5. The V2.0 compilers produce images with 2.5, V1.x produces images with 2.0." - if compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2,5 - else 2,0 + if compareILVersions v (parseILVersion ("2.0.0.0")) >= 0 then 2, 5 + else 2, 0 let peOptionalHeaderByteByCLRVersion v = // A flag in the PE file optional header seems to depend on CLI version @@ -643,7 +643,7 @@ type ILTokenMappings = EventTokenMap: ILTypeDef list * ILTypeDef -> ILEventDef -> int32 } let recordRequiredDataFixup requiredDataFixups (buf: ByteBuffer) pos lab = - requiredDataFixups := (pos,lab) :: !requiredDataFixups + requiredDataFixups := (pos, lab) :: !requiredDataFixups // Write a special value in that we check later when applying the fixup buf.EmitInt32 0xdeaddddd @@ -670,8 +670,8 @@ let GetStringHeapIdxOption cenv sopt = | None -> 0 let GetTypeNameAsElemPair cenv n = - let (n1,n2) = splitTypeNameRight n - StringE (GetStringHeapIdxOption cenv n1), + let (n1, n2) = splitTypeNameRight n + StringE (GetStringHeapIdxOption cenv n1), StringE (GetStringHeapIdx cenv n2) //===================================================================== @@ -679,7 +679,7 @@ let GetTypeNameAsElemPair cenv n = //===================================================================== let rec GenTypeDefPass1 enc cenv (td:ILTypeDef) = - ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_,n)) -> n) (TdKey (enc,td.Name))) + ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_, n)) -> n) (TdKey (enc, td.Name))) GenTypeDefsPass1 (enc@[td.Name]) cenv td.NestedTypes.AsList and GenTypeDefsPass1 enc cenv tds = List.iter (GenTypeDefPass1 enc cenv) tds @@ -692,8 +692,8 @@ let rec GetIdxForTypeDef cenv key = try cenv.typeDefs.GetTableEntry key with :? KeyNotFoundException -> - let (TdKey (enc,n) ) = key - errorR(InternalError("One of your modules expects the type '"+String.concat "." (enc@[n])+"' to be defined within the module being emitted. You may be missing an input file",range0)) + let (TdKey (enc, n) ) = key + errorR(InternalError("One of your modules expects the type '"+String.concat "." (enc@[n])+"' to be defined within the module being emitted. You may be missing an input file", range0)) 0 // -------------------------------------------------------------------- @@ -702,17 +702,17 @@ let rec GetIdxForTypeDef cenv key = let rec GetAssemblyRefAsRow cenv (aref:ILAssemblyRef) = AssemblyRefRow - ((match aref.Version with None -> 0us | Some (x,_,_,_) -> x), - (match aref.Version with None -> 0us | Some (_,y,_,_) -> y), - (match aref.Version with None -> 0us | Some (_,_,z,_) -> z), - (match aref.Version with None -> 0us | Some (_,_,_,w) -> w), + ((match aref.Version with None -> 0us | Some (x, _, _, _) -> x), + (match aref.Version with None -> 0us | Some (_, y, _, _) -> y), + (match aref.Version with None -> 0us | Some (_, _, z, _) -> z), + (match aref.Version with None -> 0us | Some (_, _, _, w) -> w), ((match aref.PublicKey with Some (PublicKey _) -> 0x0001 | _ -> 0x0000) - ||| (if aref.Retargetable then 0x0100 else 0x0000)), + ||| (if aref.Retargetable then 0x0100 else 0x0000)), BlobIndex (match aref.PublicKey with | None -> 0 - | Some (PublicKey b | PublicKeyToken b) -> GetBytesAsBlobIdx cenv b), - StringIndex (GetStringHeapIdx cenv aref.Name), - StringIndex (match aref.Locale with None -> 0 | Some s -> GetStringHeapIdx cenv s), + | Some (PublicKey b | PublicKeyToken b) -> GetBytesAsBlobIdx cenv b), + StringIndex (GetStringHeapIdx cenv aref.Name), + StringIndex (match aref.Locale with None -> 0 | Some s -> GetStringHeapIdx cenv s), BlobIndex (match aref.Hash with None -> 0 | Some s -> GetBytesAsBlobIdx cenv s)) and GetAssemblyRefAsIdx cenv aref = @@ -757,40 +757,40 @@ let GetScopeRefAsImplementationElem cenv scoref = // -------------------------------------------------------------------- let rec GetTypeRefAsTypeRefRow cenv (tref:ILTypeRef) = - let nselem,nelem = GetTypeNameAsElemPair cenv tref.Name - let rs1,rs2 = GetResolutionScopeAsElem cenv (tref.Scope,tref.Enclosing) - SharedRow [| ResolutionScope (rs1,rs2); nelem; nselem |] + let nselem, nelem = GetTypeNameAsElemPair cenv tref.Name + let rs1, rs2 = GetResolutionScopeAsElem cenv (tref.Scope, tref.Enclosing) + SharedRow [| ResolutionScope (rs1, rs2); nelem; nselem |] and GetTypeRefAsTypeRefIdx cenv tref = let mutable res = 0 - if cenv.trefCache.TryGetValue(tref,&res) then res else + if cenv.trefCache.TryGetValue(tref, &res) then res else let res = FindOrAddSharedRow cenv TableNames.TypeRef (GetTypeRefAsTypeRefRow cenv tref) cenv.trefCache.[tref] <- res res -and GetTypeDescAsTypeRefIdx cenv (scoref,enc,n) = - GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref,enc,n)) +and GetTypeDescAsTypeRefIdx cenv (scoref, enc, n) = + GetTypeRefAsTypeRefIdx cenv (mkILNestedTyRef (scoref, enc, n)) -and GetResolutionScopeAsElem cenv (scoref,enc) = +and GetResolutionScopeAsElem cenv (scoref, enc) = if isNil enc then match scoref with | ILScopeRef.Local -> (rs_Module, 1) | ILScopeRef.Assembly aref -> (rs_AssemblyRef, GetAssemblyRefAsIdx cenv aref) | ILScopeRef.Module mref -> (rs_ModuleRef, GetModuleRefAsIdx cenv mref) else - let enc2,n2 = List.frontAndBack enc - (rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref,enc2,n2)) + let enc2, n2 = List.frontAndBack enc + (rs_TypeRef, GetTypeDescAsTypeRefIdx cenv (scoref, enc2, n2)) -let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref,enc,nm) = +let emitTypeInfoAsTypeDefOrRefEncoded cenv (bb: ByteBuffer) (scoref, enc, nm) = if isScopeRefLocal scoref then - let idx = GetIdxForTypeDef cenv (TdKey(enc,nm)) + let idx = GetIdxForTypeDef cenv (TdKey(enc, nm)) bb.EmitZ32 (idx <<< 2) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeDef else - let idx = GetTypeDescAsTypeRefIdx cenv (scoref,enc,nm) + let idx = GetTypeDescAsTypeRefIdx cenv (scoref, enc, nm) bb.EmitZ32 ((idx <<< 2) ||| 0x01) // ECMA 22.2.8 TypeDefOrRefEncoded - ILTypeRef -let getTypeDefOrRefAsUncodedToken (tag,idx) = +let getTypeDefOrRefAsUncodedToken (tag, idx) = let tab = if tag = tdor_TypeDef then TableNames.TypeDef elif tag = tdor_TypeRef then TableNames.TypeRef @@ -800,13 +800,13 @@ let getTypeDefOrRefAsUncodedToken (tag,idx) = // REVIEW: write into an accumuating buffer let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) = - let sized = List.filter (function (_,Some _) -> true | _ -> false) shape - let lobounded = List.filter (function (Some _,_) -> true | _ -> false) shape + let sized = List.filter (function (_, Some _) -> true | _ -> false) shape + let lobounded = List.filter (function (Some _, _) -> true | _ -> false) shape bb.EmitZ32 shape.Length bb.EmitZ32 sized.Length - sized |> List.iter (function (_,Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") + sized |> List.iter (function (_, Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") bb.EmitZ32 lobounded.Length - lobounded |> List.iter (function (Some low,_) -> bb.EmitZ32 low | _ -> failwith "?") + lobounded |> List.iter (function (Some low, _) -> bb.EmitZ32 low | _ -> failwith "?") let hasthisToByte hasthis = match hasthis with @@ -814,7 +814,7 @@ let hasthisToByte hasthis = | ILThisConvention.InstanceExplicit -> e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT | ILThisConvention.Static -> 0x00uy -let callconvToByte ntypars (Callconv (hasthis,bcc)) = +let callconvToByte ntypars (Callconv (hasthis, bcc)) = hasthisToByte hasthis ||| (if ntypars > 0 then e_IMAGE_CEE_CS_CALLCONV_GENERIC else 0x00uy) ||| (match bcc with @@ -827,21 +827,21 @@ let callconvToByte ntypars (Callconv (hasthis,bcc)) = // REVIEW: write into an accumuating buffer -let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et,tspec:ILTypeSpec) = +let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et, tspec:ILTypeSpec) = if isNil tspec.GenericArgs then bb.EmitByte et - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name) else bb.EmitByte et_WITH bb.EmitByte et - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope, tspec.Enclosing, tspec.Name) bb.EmitZ32 tspec.GenericArgs.Length EmitTypes cenv env bb tspec.GenericArgs and GetTypeAsTypeDefOrRef cenv env (ty:ILType) = if isTypeLocal ty then let tref = ty.TypeRef - (tdor_TypeDef, GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name))) + (tdor_TypeDef, GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name))) elif ty.IsNominal && isNil ty.GenericArgs then (tdor_TypeRef, GetTypeRefAsTypeRefIdx cenv ty.TypeRef) else @@ -884,9 +884,9 @@ and EmitType cenv env bb ty = | typ when isILUIntPtrTy typ -> bb.EmitByte et_U | typ when isILTypedReferenceTy typ -> bb.EmitByte et_TYPEDBYREF - | ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS,tspec) - | ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE,tspec) - | ILType.Array (shape,ty) -> + | ILType.Boxed tspec -> EmitTypeSpec cenv env bb (et_CLASS, tspec) + | ILType.Value tspec -> EmitTypeSpec cenv env bb (et_VALUETYPE, tspec) + | ILType.Array (shape, ty) -> if shape = ILArrayShape.SingleDimensional then (bb.EmitByte et_SZARRAY ; EmitType cenv env bb ty) else (bb.EmitByte et_ARRAY; EmitType cenv env bb ty; EmitArrayShape bb shape) | ILType.TypeVar tv -> @@ -908,10 +908,10 @@ and EmitType cenv env bb ty = bb.EmitByte et_VOID | ILType.FunctionPointer x -> bb.EmitByte et_FNPTR - EmitCallsig cenv env bb (x.CallingConv,x.ArgTypes,x.ReturnType,None,0) - | ILType.Modified (req,tref,ty) -> + EmitCallsig cenv env bb (x.CallingConv, x.ArgTypes, x.ReturnType, None, 0) + | ILType.Modified (req, tref, ty) -> bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT) - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing,tref.Name) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing, tref.Name) EmitType cenv env bb ty | _ -> failwith "EmitType" @@ -920,7 +920,7 @@ and EmitLocalInfo cenv env (bb:ByteBuffer) (l:ILLocal) = bb.EmitByte et_PINNED EmitType cenv env bb l.Type -and EmitCallsig cenv env bb (callconv,args:ILTypes,ret,varargs:ILVarArgs,genarity) = +and EmitCallsig cenv env bb (callconv, args:ILTypes, ret, varargs:ILVarArgs, genarity) = bb.EmitByte (callconvToByte genarity callconv) if genarity > 0 then bb.EmitZ32 genarity bb.EmitZ32 ((args.Length + (match varargs with None -> 0 | Some l -> l.Length))) @@ -942,9 +942,9 @@ and EmitTypes cenv env bb (inst: ILTypes) = let GetTypeAsMemberRefParent cenv env ty = match GetTypeAsTypeDefOrRef cenv env ty with - | (tag,_) when tag = tdor_TypeDef -> dprintn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (mrp_TypeRef, 1) - | (tag,tok) when tag = tdor_TypeRef -> MemberRefParent (mrp_TypeRef, tok) - | (tag,tok) when tag = tdor_TypeSpec -> MemberRefParent (mrp_TypeSpec, tok) + | (tag, _) when tag = tdor_TypeDef -> dprintn "GetTypeAsMemberRefParent: mspec should have been encoded as mdtMethodDef?"; MemberRefParent (mrp_TypeRef, 1) + | (tag, tok) when tag = tdor_TypeRef -> MemberRefParent (mrp_TypeRef, tok) + | (tag, tok) when tag = tdor_TypeSpec -> MemberRefParent (mrp_TypeSpec, tok) | _ -> failwith "GetTypeAsMemberRefParent" @@ -975,7 +975,7 @@ and EmitNativeType bb ty = else match ty with | ILNativeType.Empty -> () - | ILNativeType.Custom (guid,nativeTypeName,custMarshallerName,cookieString) -> + | ILNativeType.Custom (guid, nativeTypeName, custMarshallerName, cookieString) -> let u1 = System.Text.Encoding.UTF8.GetBytes nativeTypeName let u2 = System.Text.Encoding.UTF8.GetBytes custMarshallerName let u3 = cookieString @@ -992,7 +992,7 @@ and EmitNativeType bb ty = | ILNativeType.FixedArray i -> bb.EmitByte nt_FIXEDARRAY bb.EmitZ32 i - | (* COM interop *) ILNativeType.SafeArray (vt,name) -> + | (* COM interop *) ILNativeType.SafeArray (vt, name) -> bb.EmitByte nt_SAFEARRAY bb.EmitZ32 (GetVariantTypeAsInt32 vt) match name with @@ -1000,7 +1000,7 @@ and EmitNativeType bb ty = | Some n -> let u1 = Bytes.stringAsUtf8NullTerminated n bb.EmitZ32 (Array.length u1) ; bb.EmitBytes u1 - | ILNativeType.Array (nt,sizeinfo) -> (* REVIEW: check if this corresponds to the ECMA spec *) + | ILNativeType.Array (nt, sizeinfo) -> (* REVIEW: check if this corresponds to the ECMA spec *) bb.EmitByte nt_ARRAY match nt with | None -> bb.EmitZ32 (int nt_MAX) @@ -1011,7 +1011,7 @@ and EmitNativeType bb ty = EmitNativeType bb ntt) match sizeinfo with | None -> () // chunk out with zeroes because some tools (e.g. asmmeta) read these poorly and expect further elements. - | Some (pnum,additive) -> + | Some (pnum, additive) -> // ParamNum bb.EmitZ32 pnum (* ElemMul *) (* z_u32 0x1l *) @@ -1091,7 +1091,7 @@ let GetTypeAccessFlags access = | ILTypeDefAccess.Nested ILMemberAccess.CompilerControlled -> failwith "bad type acccess" let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = - let nselem,nelem = GetTypeNameAsElemPair cenv td.Name + let nselem, nelem = GetTypeNameAsElemPair cenv td.Name let flags = if (isTypeNameForGlobalFunctions td.Name) then 0x00000000 else @@ -1134,7 +1134,7 @@ let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = nselem TypeDefOrRefOrSpec (tdorTag, tdorRow) SimpleIndex (TableNames.Field, cenv.fieldDefs.Count + 1) - SimpleIndex (TableNames.Method,cenv.methodDefIdxsByKey.Count + 1) |] + SimpleIndex (TableNames.Method, cenv.methodDefIdxsByKey.Count + 1) |] and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = match tyOpt with @@ -1152,13 +1152,13 @@ and GetTypeDefAsEventMapRow cenv tidx = SimpleIndex (TableNames.Event, cenv.eventDefs.Count + 1) |] and GetKeyForFieldDef tidx (fd: ILFieldDef) = - FieldDefKey (tidx,fd.Name, fd.Type) + FieldDefKey (tidx, fd.Name, fd.Type) and GenFieldDefPass2 cenv tidx fd = ignore (cenv.fieldDefs.AddUniqueEntry "field" (fun (fdkey:FieldDefKey) -> fdkey.Name) (GetKeyForFieldDef tidx fd)) and GetKeyForMethodDef tidx (md: ILMethodDef) = - MethodDefKey (tidx,md.GenericParams.Length, md.Name, md.Return.Type, md.ParameterTypes, md.CallingConv.IsStatic) + MethodDefKey (tidx, md.GenericParams.Length, md.Name, md.Return.Type, md.ParameterTypes, md.CallingConv.IsStatic) and GenMethodDefPass2 cenv tidx md = let idx = @@ -1179,13 +1179,13 @@ and GetKeyForPropertyDef tidx (x: ILPropertyDef) = PropKey (tidx, x.Name, x.Type, x.Args) and GenPropertyDefPass2 cenv tidx x = - ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_,n,_,_)) -> n) (GetKeyForPropertyDef tidx x)) + ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_, n, _, _)) -> n) (GetKeyForPropertyDef tidx x)) and GetTypeAsImplementsRow cenv env tidx ty = - let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow [| SimpleIndex (TableNames.TypeDef, tidx) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenImplementsPass2 cenv env tidx ty = AddUnsharedRow cenv TableNames.InterfaceImpl (GetTypeAsImplementsRow cenv env tidx ty) |> ignore @@ -1194,12 +1194,12 @@ and GetKeyForEvent tidx (x: ILEventDef) = EventKey (tidx, x.Name) and GenEventDefPass2 cenv tidx x = - ignore (cenv.eventDefs.AddUniqueEntry "event" (fun (EventKey(_,b)) -> b) (GetKeyForEvent tidx x)) + ignore (cenv.eventDefs.AddUniqueEntry "event" (fun (EventKey(_, b)) -> b) (GetKeyForEvent tidx x)) and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) let tidx2 = AddUnsharedRow cenv TableNames.TypeDef (GetTypeDefAsRow cenv env enc td) if tidx <> tidx2 then failwith "index of typedef on second pass does not match index on first pass" @@ -1253,12 +1253,12 @@ let FindMethodDefIdx cenv mdkey = else sofar) None) with | Some x -> x | None -> raise MethodDefNotFound - let (TdKey (tenc,tname)) = typeNameOfIdx mdkey.TypeIdx + let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared") dprintn ("generic arity: "+string mdkey.GenericArity) - cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2,_)) -> + cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) -> if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then - let (TdKey (tenc2,tname2)) = typeNameOfIdx mdkey2.TypeIdx + let (TdKey (tenc2, tname2)) = typeNameOfIdx mdkey2.TypeIdx dprintn ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:") dprintn ("generic arity: "+string mdkey2.GenericArity) dprintn (sprintf "mdkey2: %+A" mdkey2)) @@ -1271,7 +1271,7 @@ let rec GetMethodDefIdx cenv md = and FindFieldDefIdx cenv fdkey = try cenv.fieldDefs.GetTableEntry fdkey with :? KeyNotFoundException -> - errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared",range0)) + errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared", range0)) 1 and GetFieldDefAsFieldDefIdx cenv tidx fd = @@ -1289,28 +1289,28 @@ let GetMethodRefAsMethodDefIdx cenv (mref:ILMethodRef) = try if not (isTypeRefLocal tref) then failwithf "method referred to by method impl, event or property is not in a type defined in this module, method ref is %A" mref - let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) - let mdkey = MethodDefKey (tidx,mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) + let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name)) + let mdkey = MethodDefKey (tidx, mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) FindMethodDefIdx cenv mdkey with e -> failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message -let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm,typ,callconv,args,ret,varargs,genarity) = - MemberRefRow(GetTypeAsMemberRefParent cenv env typ, - GetStringHeapIdx cenv nm, - GetMethodRefInfoAsBlobIdx cenv fenv (callconv,args,ret,varargs,genarity)) +let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm, typ, callconv, args, ret, varargs, genarity) = + MemberRefRow(GetTypeAsMemberRefParent cenv env typ, + GetStringHeapIdx cenv nm, + GetMethodRefInfoAsBlobIdx cenv fenv (callconv, args, ret, varargs, genarity)) and GetMethodRefInfoAsBlobIdx cenv env info = GetBytesAsBlobIdx cenv (GetCallsigAsBytes cenv env info) -let GetMethodRefInfoAsMemberRefIdx cenv env ((_,typ,_,_,_,_,_) as minfo) = +let GetMethodRefInfoAsMemberRefIdx cenv env ((_, typ, _, _, _, _, _) as minfo) = let fenv = envForMethodRef env typ FindOrAddSharedRow cenv TableNames.MemberRef (MethodRefInfoAsMemberRefRow cenv env fenv minfo) -let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType,cc,args,ret,varargs,genarity) as minfo) = +let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm, typ:ILType, cc, args, ret, varargs, genarity) as minfo) = if Option.isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ" - try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRef (typ.TypeRef, cc, nm, genarity, args,ret))) + try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRef (typ.TypeRef, cc, nm, genarity, args, ret))) with MethodDefNotFound -> (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) else (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) @@ -1319,8 +1319,8 @@ let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType, // ILMethodSpec --> ILMethodRef/ILMethodDef/ILMethodSpec // -------------------------------------------------------------------- -let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm,typ,cc,args,ret,varargs,minst:ILGenericArgs) = - let mdorTag,mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm,typ,cc,args,ret,varargs,minst.Length) +let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + let mdorTag, mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm, typ, cc, args, ret, varargs, minst.Length) let blob = emitBytesViaBuffer (fun bb -> bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_GENERICINST @@ -1328,17 +1328,17 @@ let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm,typ,cc,args,ret,varargs,mi minst |> List.iter (EmitType cenv env bb)) FindOrAddSharedRow cenv TableNames.MethodSpec (SharedRow - [| MethodDefOrRef (mdorTag,mdorRow) + [| MethodDefOrRef (mdorTag, mdorRow) Blob (GetBytesAsBlobIdx cenv blob) |]) -and GetMethodDefOrRefAsUncodedToken (tag,idx) = +and GetMethodDefOrRefAsUncodedToken (tag, idx) = let tab = if tag = mdor_MethodDef then TableNames.Method elif tag = mdor_MemberRef then TableNames.MemberRef else failwith "GetMethodDefOrRefAsUncodedToken" getUncodedToken tab idx -and GetMethodSpecInfoAsUncodedToken cenv env ((_,_,_,_,_,_,minst:ILGenericArgs) as minfo) = +and GetMethodSpecInfoAsUncodedToken cenv env ((_, _, _, _, _, _, minst:ILGenericArgs) as minfo) = if minst.Length > 0 then getUncodedToken TableNames.MethodSpec (GetMethodSpecInfoAsMethodSpecIdx cenv env minfo) else @@ -1347,22 +1347,22 @@ and GetMethodSpecInfoAsUncodedToken cenv env ((_,_,_,_,_,_,minst:ILGenericArgs) and GetMethodSpecAsUncodedToken cenv env mspec = GetMethodSpecInfoAsUncodedToken cenv env (InfoOfMethodSpec mspec) -and GetMethodRefInfoOfMethodSpecInfo (nm,typ,cc,args,ret,varargs,minst:ILGenericArgs) = - (nm,typ,cc,args,ret,varargs,minst.Length) +and GetMethodRefInfoOfMethodSpecInfo (nm, typ, cc, args, ret, varargs, minst:ILGenericArgs) = + (nm, typ, cc, args, ret, varargs, minst.Length) -and GetMethodSpecAsMethodDefOrRef cenv env (mspec,varargs) = - GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec,varargs))) +and GetMethodSpecAsMethodDefOrRef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef false cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) -and GetMethodSpecAsMethodDef cenv env (mspec,varargs) = - GetMethodRefInfoAsMethodRefOrDef true cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec,varargs))) +and GetMethodSpecAsMethodDef cenv env (mspec, varargs) = + GetMethodRefInfoAsMethodRefOrDef true cenv env (GetMethodRefInfoOfMethodSpecInfo (InfoOfMethodSpec (mspec, varargs))) -and InfoOfMethodSpec (mspec:ILMethodSpec,varargs) = - (mspec.Name, - mspec.EnclosingType, - mspec.CallingConv, - mspec.FormalArgTypes, - mspec.FormalReturnType, - varargs, +and InfoOfMethodSpec (mspec:ILMethodSpec, varargs) = + (mspec.Name, + mspec.EnclosingType, + mspec.CallingConv, + mspec.FormalArgTypes, + mspec.FormalReturnType, + varargs, mspec.GenericArgs) // -------------------------------------------------------------------- @@ -1452,8 +1452,8 @@ and GenSecurityDeclsPass3 cenv hds attrs = // -------------------------------------------------------------------- let rec GetFieldSpecAsMemberRefRow cenv env fenv (fspec:ILFieldSpec) = - MemberRefRow (GetTypeAsMemberRefParent cenv env fspec.EnclosingType, - GetStringHeapIdx cenv fspec.Name, + MemberRefRow (GetTypeAsMemberRefParent cenv env fspec.EnclosingType, + GetStringHeapIdx cenv fspec.Name, GetFieldSpecSigAsBlobIdx cenv fenv fspec) and GetFieldSpecAsMemberRefIdx cenv env fspec = @@ -1476,13 +1476,13 @@ and GetFieldSpecAsFieldDefOrRef cenv env (fspec:ILFieldSpec) = if isTypeLocal typ then if not typ.IsNominal then failwith "GetFieldSpecAsFieldDefOrRef: unexpected local tref-typ" let tref = typ.TypeRef - let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) - let fdkey = FieldDefKey (tidx,fspec.Name, fspec.FormalType) + let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing, tref.Name)) + let fdkey = FieldDefKey (tidx, fspec.Name, fspec.FormalType) (true, FindFieldDefIdx cenv fdkey) else (false, GetFieldSpecAsMemberRefIdx cenv env fspec) -and GetFieldDefOrRefAsUncodedToken (tag,idx) = +and GetFieldDefOrRefAsUncodedToken (tag, idx) = let tab = if tag then TableNames.Field else TableNames.MemberRef getUncodedToken tab idx @@ -1490,11 +1490,11 @@ and GetFieldDefOrRefAsUncodedToken (tag,idx) = // callsig --> StandAloneSig // -------------------------------------------------------------------- -let GetCallsigAsBlobIdx cenv env (callsig:ILCallingSignature,varargs) = +let GetCallsigAsBlobIdx cenv env (callsig:ILCallingSignature, varargs) = GetBytesAsBlobIdx cenv - (GetCallsigAsBytes cenv env (callsig.CallingConv, - callsig.ArgTypes, - callsig.ReturnType,varargs,0)) + (GetCallsigAsBytes cenv env (callsig.CallingConv, + callsig.ArgTypes, + callsig.ReturnType, varargs, 0)) let GetCallsigAsStandAloneSigRow cenv env x = SharedRow [| Blob (GetCallsigAsBlobIdx cenv env x) |] @@ -1551,7 +1551,7 @@ type CodeBuffer = code= ByteBuffer.Create 200 reqdBrFixups=[] reqdStringFixupsInMethod=[] - availBrFixups = Dictionary<_,_>(10, HashIdentity.Structural) + availBrFixups = Dictionary<_, _>(10, HashIdentity.Structural) seqpoints = new ResizeArray<_>(10) } @@ -1612,15 +1612,15 @@ module Codebuf = if c = 0 then i elif c < 0 then go n (i-1) else go (i+1) m go 0 (Array.length arr) - let applyBrFixups (origCode :byte[]) origExnClauses origReqdStringFixups (origAvailBrFixups: Dictionary) origReqdBrFixups origSeqPoints origScopes = - let orderedOrigReqdBrFixups = origReqdBrFixups |> List.sortBy (fun (_,fixuploc,_) -> fixuploc) + let applyBrFixups (origCode :byte[]) origExnClauses origReqdStringFixups (origAvailBrFixups: Dictionary) origReqdBrFixups origSeqPoints origScopes = + let orderedOrigReqdBrFixups = origReqdBrFixups |> List.sortBy (fun (_, fixuploc, _) -> fixuploc) let newCode = ByteBuffer.Create origCode.Length // Copy over all the code, working out whether the branches will be short // or long and adjusting the branch destinations. Record an adjust function to adjust all the other // gumpf that refers to fixed offsets in the code stream. - let newCode, newReqdBrFixups,adjuster = + let newCode, newReqdBrFixups, adjuster = let remainingReqdFixups = ref orderedOrigReqdBrFixups let origWhere = ref 0 let newWhere = ref 0 @@ -1637,7 +1637,7 @@ module Codebuf = let origEndOfNoBranchBlock = if doingLast then origCode.Length else - let (_,origStartOfInstr,_) = List.head !remainingReqdFixups + let (_, origStartOfInstr, _) = List.head !remainingReqdFixups origStartOfInstr // Copy over a chunk of non-branching code @@ -1646,7 +1646,7 @@ module Codebuf = // Record how to adjust addresses in this range, including the branch instruction // we write below, or the end of the method if we're doing the last bblock - adjustments := (origStartOfNoBranchBlock,origEndOfNoBranchBlock,newStartOfNoBranchBlock) :: !adjustments + adjustments := (origStartOfNoBranchBlock, origEndOfNoBranchBlock, newStartOfNoBranchBlock) :: !adjustments // Increment locations to the branch instruction we're really interested in origWhere := origEndOfNoBranchBlock @@ -1656,7 +1656,7 @@ module Codebuf = if doingLast then doneLast := true else - let (i,origStartOfInstr,tgs:ILCodeLabel list) = List.head !remainingReqdFixups + let (i, origStartOfInstr, tgs:ILCodeLabel list) = List.head !remainingReqdFixups remainingReqdFixups := List.tail !remainingReqdFixups if origCode.[origStartOfInstr] <> 0x11uy then failwith "br fixup sanity check failed (1)" let i_length = if fst i = i_switch then 5 else 1 @@ -1667,8 +1667,8 @@ module Codebuf = let newEndOfInstrIfBig = !newWhere + i_length + 4 * tgs.Length let short = - match i,tgs with - | (_,Some i_short),[tg] + match i, tgs with + | (_, Some i_short), [tg] when begin // Use the original offsets to compute if the branch is small or large. This is @@ -1684,7 +1684,7 @@ module Codebuf = -> newCode.EmitIntAsByte i_short true - | (i_long,_),_ -> + | (i_long, _), _ -> newCode.EmitIntAsByte i_long (if i_long = i_switch then newCode.EmitInt32 tgs.Length) @@ -1714,11 +1714,11 @@ module Codebuf = let arr = Array.ofList (List.rev !adjustments) fun addr -> let i = - try binaryChop (fun (a1,a2,_) -> if addr < a1 then -1 elif addr > a2 then 1 else 0) arr + try binaryChop (fun (a1, a2, _) -> if addr < a1 then -1 elif addr > a2 then 1 else 0) arr with :? KeyNotFoundException -> failwith ("adjuster: address "+string addr+" is out of range") - let (origStartOfNoBranchBlock,_,newStartOfNoBranchBlock) = arr.[i] + let (origStartOfNoBranchBlock, _, newStartOfNoBranchBlock) = arr.[i] addr - (origStartOfNoBranchBlock - newStartOfNoBranchBlock) newCode.Close(), @@ -1727,16 +1727,16 @@ module Codebuf = // Now adjust everything let newAvailBrFixups = - let tab = Dictionary<_,_>(10, HashIdentity.Structural) - for (KeyValue(tglab,origBrDest)) in origAvailBrFixups do + let tab = Dictionary<_, _>(10, HashIdentity.Structural) + for (KeyValue(tglab, origBrDest)) in origAvailBrFixups do tab.[tglab] <- adjuster origBrDest tab - let newReqdStringFixups = List.map (fun (origFixupLoc,stok) -> adjuster origFixupLoc,stok) origReqdStringFixups + let newReqdStringFixups = List.map (fun (origFixupLoc, stok) -> adjuster origFixupLoc, stok) origReqdStringFixups let newSeqPoints = Array.map (fun (sp:PdbSequencePoint) -> {sp with Offset=adjuster sp.Offset}) origSeqPoints let newExnClauses = - origExnClauses |> List.map (fun (st1,sz1,st2,sz2,kind) -> - (adjuster st1,(adjuster (st1 + sz1) - adjuster st1), - adjuster st2,(adjuster (st2 + sz2) - adjuster st2), + origExnClauses |> List.map (fun (st1, sz1, st2, sz2, kind) -> + (adjuster st1, (adjuster (st1 + sz1) - adjuster st1), + adjuster st2, (adjuster (st2 + sz2) - adjuster st2), (match kind with | FinallyClause | FaultClause | TypeFilterClause _ -> kind | FilterClause n -> FilterClause (adjuster n)))) @@ -1749,7 +1749,7 @@ module Codebuf = List.map remap origScopes // Now apply the adjusted fixups in the new code - newReqdBrFixups |> List.iter (fun (newFixupLoc,endOfInstr,tg, small) -> + newReqdBrFixups |> List.iter (fun (newFixupLoc, endOfInstr, tg, small) -> if not (newAvailBrFixups.ContainsKey tg) then failwith ("target "+formatCodeLabel tg+" not found in new fixups") try @@ -1783,10 +1783,10 @@ module Codebuf = // for all instructions. // -------------------------------------------------------------------- - let encodingsForNoArgInstrs = Dictionary<_,_>(300, HashIdentity.Structural) + let encodingsForNoArgInstrs = Dictionary<_, _>(300, HashIdentity.Structural) let _ = List.iter - (fun (x,mk) -> encodingsForNoArgInstrs.[mk] <- x) + (fun (x, mk) -> encodingsForNoArgInstrs.[mk] <- x) (noArgInstrs.Force()) let encodingsOfNoArgInstr si = encodingsForNoArgInstrs.[si] @@ -1819,7 +1819,7 @@ module Codebuf = emitInstrCode codebuf i codebuf.EmitUncodedToken (GetFieldDefOrRefAsUncodedToken (GetFieldSpecAsFieldDefOrRef cenv env fspec)) - let emitShortUInt16Instr codebuf (i_short,i) x = + let emitShortUInt16Instr codebuf (i_short, i) x = let n = int32 x if n <= 255 then emitInstrCode codebuf i_short @@ -1828,7 +1828,7 @@ module Codebuf = emitInstrCode codebuf i codebuf.EmitUInt16 x - let emitShortInt32Instr codebuf (i_short,i) x = + let emitShortInt32Instr codebuf (i_short, i) x = if x >= (-128) && x <= 127 then emitInstrCode codebuf i_short codebuf.EmitByte (if x < 0x0 then x + 256 else x) @@ -1860,55 +1860,55 @@ module Codebuf = match instr with | si when isNoArgInstr si -> emitInstrCode codebuf (encodingsOfNoArgInstr si) - | I_brcmp (cmp,tg1) -> + | I_brcmp (cmp, tg1) -> codebuf.RecordReqdBrFixup ((Lazy.force ILCmpInstrMap).[cmp], Some (Lazy.force ILCmpInstrRevMap).[cmp]) tg1 - | I_br tg -> codebuf.RecordReqdBrFixup (i_br,Some i_br_s) tg + | I_br tg -> codebuf.RecordReqdBrFixup (i_br, Some i_br_s) tg | I_seqpoint s -> codebuf.EmitSeqPoint cenv s - | I_leave tg -> codebuf.RecordReqdBrFixup (i_leave,Some i_leave_s) tg - | I_call (tl,mspec,varargs) -> + | I_leave tg -> codebuf.RecordReqdBrFixup (i_leave, Some i_leave_s) tg + | I_call (tl, mspec, varargs) -> emitTailness cenv codebuf tl - emitMethodSpecInstr cenv codebuf env i_call (mspec,varargs) + emitMethodSpecInstr cenv codebuf env i_call (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callvirt (tl,mspec,varargs) -> + | I_callvirt (tl, mspec, varargs) -> emitTailness cenv codebuf tl - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs) + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callconstraint (tl,ty,mspec,varargs) -> + | I_callconstraint (tl, ty, mspec, varargs) -> emitTailness cenv codebuf tl emitConstrained cenv codebuf env ty - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs) + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_newobj (mspec,varargs) -> - emitMethodSpecInstr cenv codebuf env i_newobj (mspec,varargs) + | I_newobj (mspec, varargs) -> + emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) | I_ldftn mspec -> - emitMethodSpecInstr cenv codebuf env i_ldftn (mspec,None) + emitMethodSpecInstr cenv codebuf env i_ldftn (mspec, None) | I_ldvirtftn mspec -> - emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec,None) + emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec, None) - | I_calli (tl,callsig,varargs) -> + | I_calli (tl, callsig, varargs) -> emitTailness cenv codebuf tl emitInstrCode codebuf i_calli - codebuf.EmitUncodedToken (getUncodedToken TableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig,varargs))) + codebuf.EmitUncodedToken (getUncodedToken TableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig, varargs))) //emitAfterTailcall codebuf tl - | I_ldarg u16 -> emitShortUInt16Instr codebuf (i_ldarg_s,i_ldarg) u16 - | I_starg u16 -> emitShortUInt16Instr codebuf (i_starg_s,i_starg) u16 - | I_ldarga u16 -> emitShortUInt16Instr codebuf (i_ldarga_s,i_ldarga) u16 - | I_ldloc u16 -> emitShortUInt16Instr codebuf (i_ldloc_s,i_ldloc) u16 - | I_stloc u16 -> emitShortUInt16Instr codebuf (i_stloc_s,i_stloc) u16 - | I_ldloca u16 -> emitShortUInt16Instr codebuf (i_ldloca_s,i_ldloca) u16 + | I_ldarg u16 -> emitShortUInt16Instr codebuf (i_ldarg_s, i_ldarg) u16 + | I_starg u16 -> emitShortUInt16Instr codebuf (i_starg_s, i_starg) u16 + | I_ldarga u16 -> emitShortUInt16Instr codebuf (i_ldarga_s, i_ldarga) u16 + | I_ldloc u16 -> emitShortUInt16Instr codebuf (i_ldloc_s, i_ldloc) u16 + | I_stloc u16 -> emitShortUInt16Instr codebuf (i_stloc_s, i_stloc) u16 + | I_ldloca u16 -> emitShortUInt16Instr codebuf (i_ldloca_s, i_ldloca) u16 - | I_cpblk (al,vol) -> + | I_cpblk (al, vol) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf i_cpblk - | I_initblk (al,vol) -> + | I_initblk (al, vol) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf i_initblk | (AI_ldc (DT_I4, ILConst.I4 x)) -> - emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) x + emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) x | (AI_ldc (DT_I8, ILConst.I8 x)) -> emitInstrCode codebuf i_ldc_i8 codebuf.EmitInt64 x @@ -1919,7 +1919,7 @@ module Codebuf = emitInstrCode codebuf i_ldc_r8 codebuf.EmitInt64 (bitsOfDouble x) - | I_ldind (al,vol,dt) -> + | I_ldind (al, vol, dt) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf @@ -1966,7 +1966,7 @@ module Codebuf = | DT_REF -> i_ldelem_ref | _ -> failwith "ldelem") - | I_stind (al,vol,dt) -> + | I_stind (al, vol, dt) -> emitAlignment codebuf al emitVolatility codebuf vol emitInstrCode codebuf @@ -1981,24 +1981,24 @@ module Codebuf = | DT_REF -> i_stind_ref | _ -> failwith "stelem") - | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch,None) labs + | I_switch labs -> codebuf.RecordReqdBrFixups (i_switch, None) labs - | I_ldfld (al,vol,fspec) -> + | I_ldfld (al, vol, fspec) -> emitAlignment codebuf al emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldfld fspec | I_ldflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldflda fspec - | I_ldsfld (vol,fspec) -> + | I_ldsfld (vol, fspec) -> emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldsfld fspec | I_ldsflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldsflda fspec - | I_stfld (al,vol,fspec) -> + | I_stfld (al, vol, fspec) -> emitAlignment codebuf al emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stfld fspec - | I_stsfld (vol,fspec) -> + | I_stsfld (vol, fspec) -> emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stsfld fspec @@ -2008,20 +2008,20 @@ module Codebuf = (match tok with | ILToken.ILType typ -> match GetTypeAsTypeDefOrRef cenv env typ with - | (tag,idx) when tag = tdor_TypeDef -> getUncodedToken TableNames.TypeDef idx - | (tag,idx) when tag = tdor_TypeRef -> getUncodedToken TableNames.TypeRef idx - | (tag,idx) when tag = tdor_TypeSpec -> getUncodedToken TableNames.TypeSpec idx + | (tag, idx) when tag = tdor_TypeDef -> getUncodedToken TableNames.TypeDef idx + | (tag, idx) when tag = tdor_TypeRef -> getUncodedToken TableNames.TypeRef idx + | (tag, idx) when tag = tdor_TypeSpec -> getUncodedToken TableNames.TypeSpec idx | _ -> failwith "?" | ILToken.ILMethod mspec -> - match GetMethodSpecAsMethodDefOrRef cenv env (mspec,None) with - | (tag,idx) when tag = mdor_MethodDef -> getUncodedToken TableNames.Method idx - | (tag,idx) when tag = mdor_MemberRef -> getUncodedToken TableNames.MemberRef idx + match GetMethodSpecAsMethodDefOrRef cenv env (mspec, None) with + | (tag, idx) when tag = mdor_MethodDef -> getUncodedToken TableNames.Method idx + | (tag, idx) when tag = mdor_MemberRef -> getUncodedToken TableNames.MemberRef idx | _ -> failwith "?" | ILToken.ILField fspec -> match GetFieldSpecAsFieldDefOrRef cenv env fspec with - | (true,idx) -> getUncodedToken TableNames.Field idx - | (false,idx) -> getUncodedToken TableNames.MemberRef idx) + | (true, idx) -> getUncodedToken TableNames.Field idx + | (false, idx) -> getUncodedToken TableNames.MemberRef idx) | I_ldstr s -> emitInstrCode codebuf i_ldstr codebuf.RecordReqdStringFixup (GetUserStringHeapIdx cenv s) @@ -2030,59 +2030,59 @@ module Codebuf = | I_unbox ty -> emitTypeInstr cenv codebuf env i_unbox ty | I_unbox_any ty -> emitTypeInstr cenv codebuf env i_unbox_any ty - | I_newarr (shape,ty) -> + | I_newarr (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_newarr ty else let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) - emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, []) - | I_stelem_any (shape,ty) -> + | I_stelem_any (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_stelem_any ty else let args = List.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_Int32 else ty) - emitMethodSpecInfoInstr cenv codebuf env i_call ("Set",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Set", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Void, None, []) - | I_ldelem_any (shape,ty) -> + | I_ldelem_any (shape, ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelem_any ty else let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) - emitMethodSpecInfoInstr cenv codebuf env i_call ("Get",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ty,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Get", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ty, None, []) - | I_ldelema (ro,_isNativePtr,shape,ty) -> + | I_ldelema (ro, _isNativePtr, shape, ty) -> if (ro = ReadonlyAddress) then emitInstrCode codebuf i_readonly if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelema ty else let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) - emitMethodSpecInfoInstr cenv codebuf env i_call ("Address",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Byref ty,None,[]) + emitMethodSpecInfoInstr cenv codebuf env i_call ("Address", mkILArrTy(ty, shape), ILCallingConv.Instance, args, ILType.Byref ty, None, []) | I_castclass ty -> emitTypeInstr cenv codebuf env i_castclass ty | I_isinst ty -> emitTypeInstr cenv codebuf env i_isinst ty | I_refanyval ty -> emitTypeInstr cenv codebuf env i_refanyval ty | I_mkrefany ty -> emitTypeInstr cenv codebuf env i_mkrefany ty | I_initobj ty -> emitTypeInstr cenv codebuf env i_initobj ty - | I_ldobj (al,vol,ty) -> + | I_ldobj (al, vol, ty) -> emitAlignment codebuf al emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_ldobj ty - | I_stobj (al,vol,ty) -> + | I_stobj (al, vol, ty) -> emitAlignment codebuf al emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_stobj ty | I_cpobj ty -> emitTypeInstr cenv codebuf env i_cpobj ty | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty - | EI_ldlen_multi (_,m) -> - emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) m + | EI_ldlen_multi (_, m) -> + emitShortInt32Instr codebuf (i_ldc_i4_s, i_ldc_i4) m emitInstr cenv codebuf env (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [(cenv.ilg.typ_Int32)], (cenv.ilg.typ_Int32)))) | _ -> failwith "an IL instruction cannot be emitted" - let mkScopeNode cenv (localSigs: _[]) (startOffset,endOffset,ls: ILLocalDebugMapping list,childScopes) = + let mkScopeNode cenv (localSigs: _[]) (startOffset, endOffset, ls: ILLocalDebugMapping list, childScopes) = if isNil ls || not cenv.generatePdb then childScopes else [ { Children= Array.ofList childScopes @@ -2098,7 +2098,7 @@ module Codebuf = // Used to put local debug scopes and exception handlers into a tree form - let rangeInsideRange (start_pc1,end_pc1) (start_pc2,end_pc2) = + let rangeInsideRange (start_pc1, end_pc1) (start_pc2, end_pc2) = (start_pc1:int) >= start_pc2 && start_pc1 < end_pc2 && (end_pc1:int) > start_pc2 && end_pc1 <= end_pc2 @@ -2106,11 +2106,11 @@ module Codebuf = match cl with | ILExceptionClause.Finally r1 -> [r1] | ILExceptionClause.Fault r1 -> [r1] - | ILExceptionClause.FilterCatch (r1,r2) -> [r1;r2] - | ILExceptionClause.TypeCatch (_ty,r1) -> [r1] + | ILExceptionClause.FilterCatch (r1, r2) -> [r1;r2] + | ILExceptionClause.TypeCatch (_ty, r1) -> [r1] - let labelsToRange (lab2pc : Dictionary) p = let (l1,l2) = p in lab2pc.[l1], lab2pc.[l2] + let labelsToRange (lab2pc : Dictionary) p = let (l1, l2) = p in lab2pc.[l1], lab2pc.[l2] let labelRangeInsideLabelRange lab2pc ls1 ls2 = rangeInsideRange (labelsToRange lab2pc ls1) (labelsToRange lab2pc ls2) @@ -2120,16 +2120,16 @@ module Codebuf = let addToRoot roots x = // Look to see if 'x' is inside one of the roots let roots, found = - (false, roots) ||> List.mapFold (fun found (r,children) -> - if found then ((r,children),true) - elif contains x r then ((r,x::children),true) - else ((r,children),false)) + (false, roots) ||> List.mapFold (fun found (r, children) -> + if found then ((r, children), true) + elif contains x r then ((r, x::children), true) + else ((r, children), false)) if found then roots else // Find the ones that 'x' encompasses and collapse them - let yes, others = roots |> List.partition (fun (r,_) -> contains r x) - (x, yes |> List.collect (fun (r,ch) -> r :: ch)) :: others + let yes, others = roots |> List.partition (fun (r, _) -> contains r x) + (x, yes |> List.collect (fun (r, ch) -> r :: ch)) :: others ([], vs) ||> List.fold addToRoot @@ -2150,20 +2150,20 @@ module Codebuf = let roots = findRoots tryspec_inside_tryspec exs let trees = - roots |> List.map (fun (cl,ch) -> + roots |> List.map (fun (cl, ch) -> let r1 = labelsToRange lab2pc cl.Range - let conv ((s1,e1),(s2,e2)) x = pc2pos.[s1], pc2pos.[e1] - pc2pos.[s1], pc2pos.[s2], pc2pos.[e2] - pc2pos.[s2], x + let conv ((s1, e1), (s2, e2)) x = pc2pos.[s1], pc2pos.[e1] - pc2pos.[s1], pc2pos.[s2], pc2pos.[e2] - pc2pos.[s2], x let children = makeSEHTree cenv env pc2pos lab2pc ch let n = match cl.Clause with | ILExceptionClause.Finally r2 -> - conv (r1,labelsToRange lab2pc r2) ExceptionClauseKind.FinallyClause + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FinallyClause | ILExceptionClause.Fault r2 -> - conv (r1,labelsToRange lab2pc r2) ExceptionClauseKind.FaultClause - | ILExceptionClause.FilterCatch ((filterStart,_),r3) -> - conv (r1,labelsToRange lab2pc r3) (ExceptionClauseKind.FilterClause (pc2pos.[lab2pc.[filterStart]])) - | ILExceptionClause.TypeCatch (typ,r2) -> - conv (r1,labelsToRange lab2pc r2) (TypeFilterClause (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env typ))) + conv (r1, labelsToRange lab2pc r2) ExceptionClauseKind.FaultClause + | ILExceptionClause.FilterCatch ((filterStart, _), r3) -> + conv (r1, labelsToRange lab2pc r3) (ExceptionClauseKind.FilterClause (pc2pos.[lab2pc.[filterStart]])) + | ILExceptionClause.TypeCatch (typ, r2) -> + conv (r1, labelsToRange lab2pc r2) (TypeFilterClause (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env typ))) SEHTree.Node (Some n, children) ) trees @@ -2175,16 +2175,16 @@ module Codebuf = let roots = findRoots localInsideLocal exs let trees = - roots |> List.collect (fun (cl,ch) -> - let (s1,e1) = labelsToRange lab2pc cl.Range - let (s1,e1) = pc2pos.[s1], pc2pos.[e1] + roots |> List.collect (fun (cl, ch) -> + let (s1, e1) = labelsToRange lab2pc cl.Range + let (s1, e1) = pc2pos.[s1], pc2pos.[e1] let children = makeLocalsTree cenv localSigs pc2pos lab2pc ch - mkScopeNode cenv localSigs (s1,e1,cl.DebugMappings,children)) + mkScopeNode cenv localSigs (s1, e1, cl.DebugMappings, children)) trees // Emit the SEH tree - let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x,childSEH)) = + let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x, childSEH)) = List.iter (emitExceptionHandlerTree codebuf) childSEH // internal first x |> Option.iter codebuf.EmitExceptionClause @@ -2194,7 +2194,7 @@ module Codebuf = // Build a table mapping Abstract IL pcs to positions in the generated code buffer let pc2pos = Array.zeroCreate (instrs.Length+1) let pc2labs = Dictionary() - for (KeyValue(lab,pc)) in code.Labels do + for (KeyValue(lab, pc)) in code.Labels do if pc2labs.ContainsKey pc then pc2labs.[pc] <- lab :: pc2labs.[pc] else pc2labs.[pc] <- [lab] // Emit the instructions @@ -2235,7 +2235,7 @@ module Codebuf = EndOffset=newCode.Length Locals=[| |] } - (newReqdStringFixups,newExnClauses, newCode, newSeqPoints, rootScope) + (newReqdStringFixups, newExnClauses, newCode, newSeqPoints, rootScope) // -------------------------------------------------------------------- // ILMethodBody --> bytes @@ -2256,7 +2256,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = else [| |] - let requiredStringFixups,seh,code,seqpoints, scopes = Codebuf.EmitTopCode cenv localSigs env mname il.Code + let requiredStringFixups, seh, code, seqpoints, scopes = Codebuf.EmitTopCode cenv localSigs env mname il.Code let codeSize = code.Length let methbuf = ByteBuffer.Create (codeSize * 3) // Do we use the tiny format? @@ -2264,7 +2264,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = // Use Tiny format let alignedCodeSize = align 4 (codeSize + 1) let codePadding = (alignedCodeSize - (codeSize + 1)) - let requiredStringFixups' = (1,requiredStringFixups) + let requiredStringFixups' = (1, requiredStringFixups) methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat) methbuf.EmitBytes code methbuf.EmitPadding codePadding @@ -2297,7 +2297,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = let smallSize = (seh.Length * 12 + 4) let canUseSmall = smallSize <= 0xFF && - seh |> List.forall (fun (st1,sz1,st2,sz2,_) -> + seh |> List.forall (fun (st1, sz1, st2, sz2, _) -> st1 <= 0xFFFF && st2 <= 0xFFFF && sz1 <= 0xFF && sz2 <= 0xFF) let kindAsInt32 k = @@ -2317,7 +2317,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitByte (b0 smallSize) methbuf.EmitByte 0x00uy methbuf.EmitByte 0x00uy - seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> + seh |> List.iter (fun (st1, sz1, st2, sz2, kind) -> let k32 = kindAsInt32 kind methbuf.EmitInt32AsUInt16 k32 methbuf.EmitInt32AsUInt16 st1 @@ -2331,7 +2331,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitByte (b0 bigSize) methbuf.EmitByte (b1 bigSize) methbuf.EmitByte (b2 bigSize) - seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> + seh |> List.iter (fun (st1, sz1, st2, sz2, kind) -> let k32 = kindAsInt32 kind methbuf.EmitInt32 k32 methbuf.EmitInt32 st1 @@ -2340,7 +2340,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = methbuf.EmitInt32 sz2 methbuf.EmitInt32 (kindAsExtraInt32 kind)) - let requiredStringFixups' = (12,requiredStringFixups) + let requiredStringFixups' = (12, requiredStringFixups) localToken, (requiredStringFixups', methbuf.Close()), seqpoints, scopes @@ -2369,7 +2369,7 @@ and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.T and GenFieldDefPass3 cenv env fd = let fidx = AddUnsharedRow cenv TableNames.Field (GetFieldDefAsFieldDefRow cenv env fd) - GenCustomAttrsPass3Or4 cenv (hca_FieldDef,fidx) fd.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_FieldDef, fidx) fd.CustomAttrs // Write FieldRVA table - fixups into data section done later match fd.Data with | None -> () @@ -2377,7 +2377,7 @@ and GenFieldDefPass3 cenv env fd = let offs = cenv.data.Position cenv.data.EmitBytes b AddUnsharedRow cenv TableNames.FieldRVA - (UnsharedRow [| Data (offs, false); SimpleIndex (TableNames.Field,fidx) |]) |> ignore + (UnsharedRow [| Data (offs, false); SimpleIndex (TableNames.Field, fidx) |]) |> ignore // Write FieldMarshal table match fd.Marshal with | None -> () @@ -2416,7 +2416,7 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = (if gp.HasNotNullableValueTypeConstraint then 0x0008 else 0x0000) ||| (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000) - let mdVersionMajor,_ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion + let mdVersionMajor, _ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion if (mdVersionMajor = 1) then SharedRow [| UShort (uint16 idx) @@ -2432,10 +2432,10 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = StringE (GetStringHeapIdx cenv gp.Name) |] and GenTypeAsGenericParamConstraintRow cenv env gpidx ty = - let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty + let tdorTag, tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow [| SimpleIndex (TableNames.GenericParam, gpidx) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenGenericParamConstraintPass4 cenv env gpidx ty = AddUnsharedRow cenv TableNames.GenericParamConstraint (GenTypeAsGenericParamConstraintRow cenv env gpidx ty) |> ignore @@ -2474,7 +2474,7 @@ and GenParamPass3 cenv env seq (param: ILParameter) = then () else let pidx = AddUnsharedRow cenv TableNames.Param (GetParamAsParamRow cenv env seq param) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) param.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ParamDef, pidx) param.CustomAttrs // Write FieldRVA table - fixups into data section done later match param.Marshal with | None -> () @@ -2501,7 +2501,7 @@ let GenReturnAsParamRow (returnv : ILReturn) = let GenReturnPass3 cenv (returnv: ILReturn) = if Option.isSome returnv.Marshal || not (isNil returnv.CustomAttrs.AsList) then let pidx = AddUnsharedRow cenv TableNames.Param (GenReturnAsParamRow returnv) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) returnv.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ParamDef, pidx) returnv.CustomAttrs match returnv.Marshal with | None -> () | Some ntyp -> @@ -2586,7 +2586,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = Some ({ Document=doc Line=m.Line - Column=m.Column }, + Column=m.Column }, { Document=doc Line=m.EndLine Column=m.EndColumn }) @@ -2616,10 +2616,10 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = UShort (uint16 flags) StringE (GetStringHeapIdx cenv md.Name) Blob (GenMethodDefSigAsBlobIdx cenv env md) - SimpleIndex(TableNames.Param,cenv.GetTable(TableNames.Param).Count + 1) |] + SimpleIndex(TableNames.Param, cenv.GetTable(TableNames.Param).Count + 1) |] let GenMethodImplPass3 cenv env _tgparams tidx mimpl = - let midxTag, midxRow = GetMethodSpecAsMethodDef cenv env (mimpl.OverrideBy,None) + let midxTag, midxRow = GetMethodSpecAsMethodDef cenv env (mimpl.OverrideBy, None) let midx2Tag, midx2Row = GetOverridesSpecAsMethodDefOrRef cenv env mimpl.Overrides AddUnsharedRow cenv TableNames.MethodImpl (UnsharedRow @@ -2633,8 +2633,8 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) = if midx <> idx2 then failwith "index of method def on pass 3 does not match index on pass 2" GenReturnPass3 cenv md.Return md.Parameters |> List.iteri (fun n param -> GenParamPass3 cenv env (n+1) param) - md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef,midx) - md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef,midx) + md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef, midx) + md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef, midx) md.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_MethodDef, midx) gp) match md.mdBody.Contents with | MethodBody.PInvoke attr -> @@ -2668,7 +2668,7 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) = AddUnsharedRow cenv TableNames.ImplMap (UnsharedRow [| UShort (uint16 flags) - MemberForwarded (mf_MethodDef,midx) + MemberForwarded (mf_MethodDef, midx) StringE (GetStringHeapIdx cenv attr.Name) SimpleIndex (TableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where) |]) |> ignore | _ -> () @@ -2683,7 +2683,7 @@ let GenPropertyMethodSemanticsPass3 cenv pidx kind mref = AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow [| UShort (uint16 kind) - SimpleIndex (TableNames.Method,midx) + SimpleIndex (TableNames.Method, midx) HasSemantics (hs_Property, pidx) |]) |> ignore let rec GetPropertySigAsBlobIdx cenv env prop = @@ -2721,14 +2721,14 @@ and GenPropertyPass3 cenv env prop = [| GetFieldInitFlags i HasConstant (hc_Property, pidx) Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore - GenCustomAttrsPass3Or4 cenv (hca_Property,pidx) prop.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_Property, pidx) prop.CustomAttrs let rec GenEventMethodSemanticsPass3 cenv eidx kind mref = let addIdx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow [| UShort (uint16 kind) - SimpleIndex (TableNames.Method,addIdx) + SimpleIndex (TableNames.Method, addIdx) HasSemantics (hs_Event, eidx) |]) |> ignore /// ILEventDef --> Event Row + MethodSemantics entries @@ -2740,7 +2740,7 @@ and GenEventAsEventRow cenv env (md: ILEventDef) = UnsharedRow [| UShort (uint16 flags) StringE (GetStringHeapIdx cenv md.Name) - TypeDefOrRefOrSpec (tdorTag,tdorRow) |] + TypeDefOrRefOrSpec (tdorTag, tdorRow) |] and GenEventPass3 cenv env (md: ILEventDef) = let eidx = AddUnsharedRow cenv TableNames.Event (GenEventAsEventRow cenv env md) @@ -2748,7 +2748,7 @@ and GenEventPass3 cenv env (md: ILEventDef) = md.RemoveMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0010 Option.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0020) md.FireMethod List.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0004) md.OtherMethods - GenCustomAttrsPass3Or4 cenv (hca_Event,eidx) md.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_Event, eidx) md.CustomAttrs // -------------------------------------------------------------------- @@ -2756,7 +2756,7 @@ and GenEventPass3 cenv env (md: ILEventDef) = // -------------------------------------------------------------------- let rec GetResourceAsManifestResourceRow cenv r = - let data,impl = + let data, impl = match r.Location with | ILResourceLocation.Local bf -> let b = bf() @@ -2769,8 +2769,8 @@ let rec GetResourceAsManifestResourceRow cenv r = cenv.resources.EmitPadding pad cenv.resources.EmitInt32 resourceSize cenv.resources.EmitBytes b - Data (alignedOffset,true), (i_File, 0) - | ILResourceLocation.File (mref,offset) -> ULong offset, (i_File, GetModuleRefAsFileIdx cenv mref) + Data (alignedOffset, true), (i_File, 0) + | ILResourceLocation.File (mref, offset) -> ULong offset, (i_File, GetModuleRefAsFileIdx cenv mref) | ILResourceLocation.Assembly aref -> ULong 0x0, (i_AssemblyRef, GetAssemblyRefAsIdx cenv aref) UnsharedRow [| data @@ -2780,7 +2780,7 @@ let rec GetResourceAsManifestResourceRow cenv r = and GenResourcePass3 cenv r = let idx = AddUnsharedRow cenv TableNames.ManifestResource (GetResourceAsManifestResourceRow cenv r) - GenCustomAttrsPass3Or4 cenv (hca_ManifestResource,idx) r.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ManifestResource, idx) r.CustomAttrs // -------------------------------------------------------------------- // ILTypeDef --> generate ILFieldDef, ILMethodDef, ILPropertyDef etc. rows @@ -2789,7 +2789,7 @@ and GenResourcePass3 cenv r = let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) td.Properties.AsList |> List.iter (GenPropertyPass3 cenv env) td.Events.AsList |> List.iter (GenEventPass3 cenv env) td.Fields.AsList |> List.iter (GenFieldDefPass3 cenv env) @@ -2806,9 +2806,9 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = ULong (defaultArg layout.Size 0x0) SimpleIndex (TableNames.TypeDef, tidx) |]) |> ignore - td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef,tidx) - td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef,tidx) - td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef,tidx) gp) + td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef, tidx) + td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef, tidx) + td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef, tidx) gp) td.NestedTypes.AsList |> GenTypeDefsPass3 (enc@[td.Name]) cenv with e -> failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message) @@ -2824,9 +2824,9 @@ and GenTypeDefsPass3 enc cenv tds = let rec GenTypeDefPass4 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td - let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) + let tidx = GetIdxForTypeDef cenv (TdKey(enc, td.Name)) td.Methods |> Seq.iter (GenMethodDefPass4 cenv env) - List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef,tidx) gp) td.GenericParams + List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef, tidx) gp) td.GenericParams GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsList with e -> failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message) @@ -2853,14 +2853,14 @@ let rec GenNestedExportedTypePass3 cenv cidx (ce: ILNestedExportedType) = StringE (GetStringHeapIdx cenv ce.Name) StringE 0 Implementation (i_ExportedType, cidx) |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,nidx) ce.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ExportedType, nidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv nidx ce.Nested and GenNestedExportedTypesPass3 cenv nidx (nce: ILNestedExportedTypes) = nce.AsList |> List.iter (GenNestedExportedTypePass3 cenv nidx) and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = - let nselem,nelem = GetTypeNameAsElemPair cenv ce.Name + let nselem, nelem = GetTypeNameAsElemPair cenv ce.Name let flags = GetTypeAccessFlags ce.Access let flags = if ce.IsForwarder then 0x00200000 ||| flags else flags let impl = GetScopeRefAsImplementationElem cenv ce.ScopeRef @@ -2872,7 +2872,7 @@ and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = nelem nselem Implementation (fst impl, snd impl) |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,cidx) ce.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_ExportedType, cidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv cidx ce.Nested and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = @@ -2885,10 +2885,10 @@ and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = and GetManifsetAsAssemblyRow cenv m = UnsharedRow [|ULong m.AuxModuleHashAlgorithm - UShort (match m.Version with None -> 0us | Some (x,_,_,_) -> x) - UShort (match m.Version with None -> 0us | Some (_,y,_,_) -> y) - UShort (match m.Version with None -> 0us | Some (_,_,z,_) -> z) - UShort (match m.Version with None -> 0us | Some (_,_,_,w) -> w) + UShort (match m.Version with None -> 0us | Some (x, _, _, _) -> x) + UShort (match m.Version with None -> 0us | Some (_, y, _, _) -> y) + UShort (match m.Version with None -> 0us | Some (_, _, z, _) -> z) + UShort (match m.Version with None -> 0us | Some (_, _, _, w) -> w) ULong ( (match m.AssemblyLongevity with | ILAssemblyLongevity.Unspecified -> 0x0000 @@ -2908,8 +2908,8 @@ and GetManifsetAsAssemblyRow cenv m = and GenManifestPass3 cenv m = let aidx = AddUnsharedRow cenv TableNames.Assembly (GetManifsetAsAssemblyRow cenv m) - GenSecurityDeclsPass3 cenv (hds_Assembly,aidx) m.SecurityDecls.AsList - GenCustomAttrsPass3Or4 cenv (hca_Assembly,aidx) m.CustomAttrs + GenSecurityDeclsPass3 cenv (hds_Assembly, aidx) m.SecurityDecls.AsList + GenCustomAttrsPass3Or4 cenv (hca_Assembly, aidx) m.CustomAttrs GenExportedTypesPass3 cenv m.ExportedTypes // Record the entrypoint decl if needed. match m.EntrypointElsewhere with @@ -2972,7 +2972,7 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m) GenTypeDefsPass3 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 3" - GenCustomAttrsPass3Or4 cenv (hca_Module,midx) modul.CustomAttrs + GenCustomAttrsPass3Or4 cenv (hca_Module, midx) modul.CustomAttrs // GenericParam is the only sorted table indexed by Columns in other tables (GenericParamConstraint\CustomAttributes). // Hence we need to sort it before we emit any entries in GenericParamConstraint\CustomAttributes that are attached to generic params. // Note this mutates the rows in a table. 'SetRowsOfTable' clears @@ -2981,7 +2981,7 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = GenTypeDefsPass4 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 4" -let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress = +let generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg : ILGlobals, emitTailcalls, deterministic, showTimes) (m : ILModuleDef) cilStartAddress = let isDll = m.IsDLL let cenv = @@ -3007,29 +3007,29 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG i = TableNames.MethodSpec.Index || i = TableNames.StandAloneSig.Index || i = TableNames.GenericParam.Index) then - MetadataTable.Shared (MetadataTable.New ("row table "+string i,EqualityComparer.Default)) + MetadataTable.Shared (MetadataTable.New ("row table "+string i, EqualityComparer.Default)) else - MetadataTable.Unshared (MetadataTable.New ("row table "+string i,EqualityComparer.Default))) + MetadataTable.Unshared (MetadataTable.New ("row table "+string i, EqualityComparer.Default))) - AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef",EqualityComparer.Default) - documents=MetadataTable<_>.New("pdbdocs",EqualityComparer.Default) - trefCache=new Dictionary<_,_>(100) + AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef", EqualityComparer.Default) + documents=MetadataTable<_>.New("pdbdocs", EqualityComparer.Default) + trefCache=new Dictionary<_, _>(100) pdbinfo= new ResizeArray<_>(200) moduleGuid= Array.zeroCreate 16 - fieldDefs= MetadataTable<_>.New("field defs",EqualityComparer.Default) - methodDefIdxsByKey = MetadataTable<_>.New("method defs",EqualityComparer.Default) + fieldDefs= MetadataTable<_>.New("field defs", EqualityComparer.Default) + methodDefIdxsByKey = MetadataTable<_>.New("method defs", EqualityComparer.Default) // This uses reference identity on ILMethodDef objects - methodDefIdxs = new Dictionary<_,_>(100, HashIdentity.Reference) - propertyDefs = MetadataTable<_>.New("property defs",EqualityComparer.Default) - eventDefs = MetadataTable<_>.New("event defs",EqualityComparer.Default) - typeDefs = MetadataTable<_>.New("type defs",EqualityComparer.Default) + methodDefIdxs = new Dictionary<_, _>(100, HashIdentity.Reference) + propertyDefs = MetadataTable<_>.New("property defs", EqualityComparer.Default) + eventDefs = MetadataTable<_>.New("event defs", EqualityComparer.Default) + typeDefs = MetadataTable<_>.New("type defs", EqualityComparer.Default) entrypoint=None generatePdb=generatePdb // These must use structural comparison since they are keyed by arrays - guids=MetadataTable<_>.New("guids",HashIdentity.Structural) - blobs= MetadataTable<_>.New("blobs",HashIdentity.Structural) - strings= MetadataTable<_>.New("strings",EqualityComparer.Default) - userStrings= MetadataTable<_>.New("user strings",EqualityComparer.Default) } + guids=MetadataTable<_>.New("guids", HashIdentity.Structural) + blobs= MetadataTable<_>.New("blobs", HashIdentity.Structural) + strings= MetadataTable<_>.New("strings", EqualityComparer.Default) + userStrings= MetadataTable<_>.New("user strings", EqualityComparer.Default) } // Now the main compilation step GenModule cenv m @@ -3037,7 +3037,7 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG // .exe files have a .entrypoint instruction. Do not write it to the entrypoint when writing dll. let entryPointToken = match cenv.entrypoint with - | Some (epHere,tok) -> + | Some (epHere, tok) -> if isDll then 0x0 else getUncodedToken (if epHere then TableNames.Method else TableNames.File) tok | None -> @@ -3082,14 +3082,14 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG // New return the results let data = cenv.data.Close() let resources = cenv.resources.Close() - (strings,userStrings,blobs,guids,tables,entryPointToken,code,cenv.requiredStringFixups,data,resources,pdbData,mappings) + (strings, userStrings, blobs, guids, tables, entryPointToken, code, cenv.requiredStringFixups, data, resources, pdbData, mappings) //===================================================================== // TABLES+BLOBS --> PHYSICAL METADATA+BLOBS //===================================================================== -let chunk sz next = ({addr=next; size=sz},next + sz) -let nochunk next = ({addr= 0x0;size= 0x0; } ,next) +let chunk sz next = ({addr=next; size=sz}, next + sz) +let nochunk next = ({addr= 0x0;size= 0x0; } , next) let count f arr = Array.fold (fun x y -> x + f y) 0x0 arr @@ -3110,13 +3110,13 @@ module FileSystemUtilites = let monoPosix = Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n" let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo") - let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |],CultureInfo.InvariantCulture) - let prevPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |],CultureInfo.InvariantCulture) + let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |], CultureInfo.InvariantCulture) + let prevPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |], CultureInfo.InvariantCulture) let prevPermissionsValue = prevPermissions |> unbox let newPermissionsValue = prevPermissionsValue ||| 0x000001ED let newPermissions = Enum.ToObject(prevPermissions.GetType(), newPermissionsValue) // Add 0x000001ED (UserReadWriteExecute, GroupReadExecute, OtherReadExecute) to the access permissions on Unix - monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| newPermissions |],CultureInfo.InvariantCulture) |> ignore + monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| newPermissions |], CultureInfo.InvariantCulture) |> ignore with e -> if progress then eprintf "failure: %s...\n" (e.ToString()) // Fail silently @@ -3126,7 +3126,7 @@ module FileSystemUtilites = #endif () -let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,deterministic,showTimes) modul cilStartAddress = +let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress = // When we know the real RVAs of the data section we fixup the references for the FieldRVA table. // These references are stored as offsets into the metadata we return from this function @@ -3134,8 +3134,8 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let next = cilStartAddress - let strings,userStrings,blobs,guids,tables,entryPointToken,code,requiredStringFixups,data,resources,pdbData,mappings = - generateIL requiredDataFixups (desiredMetadataVersion,generatePdb,ilg,emitTailcalls,deterministic,showTimes) modul cilStartAddress + let strings, userStrings, blobs, guids, tables, entryPointToken, code, requiredStringFixups, data, resources, pdbData, mappings = + generateIL requiredDataFixups (desiredMetadataVersion, generatePdb, ilg, emitTailcalls, deterministic, showTimes) modul cilStartAddress reportTime showTimes "Generated Tables and Code" let tableSize (tab: TableName) = tables.[tab.Index].Count @@ -3143,19 +3143,19 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Now place the code let codeSize = code.Length let alignedCodeSize = align 0x4 codeSize - let codep,next = chunk codeSize next + let codep, next = chunk codeSize next let codePadding = Array.create (alignedCodeSize - codeSize) 0x0uy - let _codePaddingChunk,next = chunk codePadding.Length next + let _codePaddingChunk, next = chunk codePadding.Length next // Now layout the chunks of metadata and IL - let metadataHeaderStartChunk,_next = chunk 0x10 next + let metadataHeaderStartChunk, _next = chunk 0x10 next let numStreams = 0x05 let (mdtableVersionMajor, mdtableVersionMinor) = metadataSchemaVersionSupportedByCLRVersion desiredMetadataVersion let version = - let (a,b,c,_) = desiredMetadataVersion + let (a, b, c, _) = desiredMetadataVersion System.Text.Encoding.UTF8.GetBytes (sprintf "v%d.%d.%d" a b c) @@ -3164,13 +3164,13 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Most addresses after this point are measured from the MD root // Switch to md-rooted addresses let next = metadataHeaderStartChunk.size - let _metadataHeaderVersionChunk,next = chunk paddedVersionLength next - let _metadataHeaderEndChunk,next = chunk 0x04 next - let _tablesStreamHeaderChunk,next = chunk (0x08 + (align 4 ("#~".Length + 0x01))) next - let _stringsStreamHeaderChunk,next = chunk (0x08 + (align 4 ("#Strings".Length + 0x01))) next - let _userStringsStreamHeaderChunk,next = chunk (0x08 + (align 4 ("#US".Length + 0x01))) next - let _guidsStreamHeaderChunk,next = chunk (0x08 + (align 4 ("#GUID".Length + 0x01))) next - let _blobsStreamHeaderChunk,next = chunk (0x08 + (align 4 ("#Blob".Length + 0x01))) next + let _metadataHeaderVersionChunk, next = chunk paddedVersionLength next + let _metadataHeaderEndChunk, next = chunk 0x04 next + let _tablesStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#~".Length + 0x01))) next + let _stringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Strings".Length + 0x01))) next + let _userStringsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#US".Length + 0x01))) next + let _guidsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#GUID".Length + 0x01))) next + let _blobsStreamHeaderChunk, next = chunk (0x08 + (align 4 ("#Blob".Length + 0x01))) next let tablesStreamStart = next @@ -3191,13 +3191,13 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let blobsBig = blobsStreamPaddedSize >= 0x10000 // 64bit bitvector indicating which tables are in the metadata. - let (valid1,valid2),_ = - (((0,0), 0), tables) ||> Array.fold (fun ((valid1,valid2) as valid,n) rows -> + let (valid1, valid2), _ = + (((0, 0), 0), tables) ||> Array.fold (fun ((valid1, valid2) as valid, n) rows -> let valid = if rows.Count = 0 then valid else - ( (if n < 32 then valid1 ||| (1 <<< n ) else valid1), + ( (if n < 32 then valid1 ||| (1 <<< n ) else valid1), (if n >= 32 then valid2 ||| (1 <<< (n-32)) else valid2) ) - (valid,n+1)) + (valid, n+1)) // 64bit bitvector indicating which tables are sorted. // Constant - REVIEW: make symbolic! compute from sorted table info! @@ -3419,15 +3419,15 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // QUERY: extra 4 empty bytes in array.exe - why? Include some extra padding after // the tables just in case there is a mistake in the ECMA spec. let tablesStreamPaddedSize = align 4 (tablesStreamUnpaddedSize + 4) - let tablesChunk,next = chunk tablesStreamPaddedSize next + let tablesChunk, next = chunk tablesStreamPaddedSize next let tablesStreamPadding = tablesChunk.size - tablesStreamUnpaddedSize - let stringsChunk,next = chunk stringsStreamPaddedSize next + let stringsChunk, next = chunk stringsStreamPaddedSize next let stringsStreamPadding = stringsChunk.size - stringsStreamUnpaddedSize - let userStringsChunk,next = chunk userStringsStreamPaddedSize next + let userStringsChunk, next = chunk userStringsStreamPaddedSize next let userStringsStreamPadding = userStringsChunk.size - userStringsStreamUnpaddedSize - let guidsChunk,next = chunk (0x10 * guids.Length) next - let blobsChunk,_next = chunk blobsStreamPaddedSize next + let guidsChunk, next = chunk (0x10 * guids.Length) next + let blobsChunk, _next = chunk blobsStreamPaddedSize next let blobsStreamPadding = blobsChunk.size - blobsStreamUnpaddedSize reportTime showTimes "Layout Metadata" @@ -3508,7 +3508,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Now we know the user string tables etc. we can fixup the // uses of strings in the code for (codeStartAddr, l) in requiredStringFixups do - for (codeOffset,userStringIndex) in l do + for (codeOffset, userStringIndex) in l do if codeStartAddr < codep.addr || codeStartAddr >= codep.addr + codep.size then failwith "strings-in-code fixup: a group of fixups is located outside the code array"; let locInCode = ((codeStartAddr + codeOffset) - codep.addr) checkFixup32 code locInCode 0xdeadbeef; @@ -3517,7 +3517,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls applyFixup32 code locInCode token reportTime showTimes "Fixup Metadata"; - entryPointToken,code, codePadding,metadata,data,resources,!requiredDataFixups,pdbData,mappings,guidStart + entryPointToken, code, codePadding, metadata, data, resources, !requiredDataFixups, pdbData, mappings, guidStart //--------------------------------------------------------------------- // PHYSICAL METADATA+BLOBS --> PHYSICAL PE FORMAT @@ -3575,7 +3575,7 @@ let writeDirectory os dict = writeInt32 os (if dict.size = 0x0 then 0x0 else dict.addr); writeInt32 os dict.size -let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length) +let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk, 0, chunk.Length) let writeBinaryAndReportMappings (outfile, ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, @@ -3587,7 +3587,7 @@ let writeBinaryAndReportMappings (outfile, let isDll = modul.IsDLL let signer = - match signer,modul.Manifest with + match signer, modul.Manifest with | Some _, _ -> signer | _, None -> signer | None, Some {PublicKey=Some pubkey} -> @@ -3627,7 +3627,7 @@ let writeBinaryAndReportMappings (outfile, with e -> failwith ("Could not open file for writing (binary mode): " + outfile) - let pdbData,pdbOpt,debugDirectoryChunk,debugDataChunk,debugEmbeddedPdbChunk,textV2P,mappings = + let pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings = try let imageBaseReal = modul.ImageBase // FIXED CHOICE @@ -3646,25 +3646,25 @@ let writeBinaryAndReportMappings (outfile, let next = headerAddr let msdosHeaderSize = 0x80 - let msdosHeaderChunk,next = chunk msdosHeaderSize next + let msdosHeaderChunk, next = chunk msdosHeaderSize next let peSignatureSize = 0x04 - let peSignatureChunk,next = chunk peSignatureSize next + let peSignatureChunk, next = chunk peSignatureSize next let peFileHeaderSize = 0x14 - let peFileHeaderChunk,next = chunk peFileHeaderSize next + let peFileHeaderChunk, next = chunk peFileHeaderSize next let peOptionalHeaderSize = if modul.Is64Bit then 0xf0 else 0xe0 - let peOptionalHeaderChunk,next = chunk peOptionalHeaderSize next + let peOptionalHeaderChunk, next = chunk peOptionalHeaderSize next let textSectionHeaderSize = 0x28 - let textSectionHeaderChunk,next = chunk textSectionHeaderSize next + let textSectionHeaderChunk, next = chunk textSectionHeaderSize next let dataSectionHeaderSize = 0x28 - let dataSectionHeaderChunk,next = chunk dataSectionHeaderSize next + let dataSectionHeaderChunk, next = chunk dataSectionHeaderSize next let relocSectionHeaderSize = 0x28 - let relocSectionHeaderChunk,next = chunk relocSectionHeaderSize next + let relocSectionHeaderChunk, next = chunk relocSectionHeaderSize next let headerSize = next - headerAddr let nextPhys = align alignPhys (headerSectionPhysLoc + headerSize) @@ -3677,10 +3677,10 @@ let writeBinaryAndReportMappings (outfile, let textSectionAddr = next let next = textSectionAddr - let importAddrTableChunk,next = chunk 0x08 next + let importAddrTableChunk, next = chunk 0x08 next let cliHeaderPadding = (if isItanium then (align 16 next) else next) - next let next = next + cliHeaderPadding - let cliHeaderChunk,next = chunk 0x48 next + let cliHeaderChunk, next = chunk 0x48 next let desiredMetadataVersion = if modul.MetadataVersion <> "" then @@ -3691,43 +3691,43 @@ let writeBinaryAndReportMappings (outfile, | ILScopeRef.Module(_) -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Module" | ILScopeRef.Assembly(aref) -> match aref.Version with - | Some (2us,_,_,_) -> parseILVersion "2.0.50727.0" + | Some (2us, _, _, _) -> parseILVersion "2.0.50727.0" | Some v -> v | None -> failwith "Expected msorlib to have a version number" - let entryPointToken,code,codePadding,metadata,data,resources,requiredDataFixups,pdbData,mappings,guidStart = - writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg,emitTailcalls, deterministic, showTimes) modul next + let entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups, pdbData, mappings, guidStart = + writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul next reportTime showTimes "Generated IL and metadata"; - let _codeChunk,next = chunk code.Length next - let _codePaddingChunk,next = chunk codePadding.Length next + let _codeChunk, next = chunk code.Length next + let _codePaddingChunk, next = chunk codePadding.Length next - let metadataChunk,next = chunk metadata.Length next + let metadataChunk, next = chunk metadata.Length next - let strongnameChunk,next = + let strongnameChunk, next = match signer with | None -> nochunk next | Some s -> chunk s.SignatureSize next - let resourcesChunk,next = chunk resources.Length next + let resourcesChunk, next = chunk resources.Length next - let rawdataChunk,next = chunk data.Length next + let rawdataChunk, next = chunk data.Length next - let vtfixupsChunk,next = nochunk next // Note: only needed for mixed mode assemblies + let vtfixupsChunk, next = nochunk next // Note: only needed for mixed mode assemblies let importTableChunkPrePadding = (if isItanium then (align 16 next) else next) - next let next = next + importTableChunkPrePadding - let importTableChunk,next = chunk 0x28 next - let importLookupTableChunk,next = chunk 0x14 next - let importNameHintTableChunk,next = chunk 0x0e next - let mscoreeStringChunk,next = chunk 0x0c next + let importTableChunk, next = chunk 0x28 next + let importLookupTableChunk, next = chunk 0x14 next + let importNameHintTableChunk, next = chunk 0x0e next + let mscoreeStringChunk, next = chunk 0x0c next let next = align 0x10 (next + 0x05) - 0x05 let importTableChunk = { addr=importTableChunk.addr; size = next - importTableChunk.addr} let importTableChunkPadding = importTableChunk.size - (0x28 + 0x14 + 0x0e + 0x0c) let next = next + 0x03 - let entrypointCodeChunk,next = chunk 0x06 next - let globalpointerCodeChunk,next = chunk (if isItanium then 0x8 else 0x0) next + let entrypointCodeChunk, next = chunk 0x06 next + let globalpointerCodeChunk, next = chunk (if isItanium then 0x8 else 0x0) next let pdbOpt = match portablePDB with @@ -3736,7 +3736,7 @@ let writeBinaryAndReportMappings (outfile, if embeddedPDB then Some (compressPortablePdbStream uncompressedLength contentId stream) else Some (pdbStream) | _ -> None - let debugDirectoryChunk,next = + let debugDirectoryChunk, next = chunk (if pdbfile = None then 0x0 else if embeddedPDB && portablePDB then @@ -3749,17 +3749,17 @@ let writeBinaryAndReportMappings (outfile, // this in after we've written the binary. We approximate the size according // to what PDB writers seem to require and leave extra space just in case... let debugDataJustInCase = 40 - let debugDataChunk,next = + let debugDataChunk, next = chunk (align 0x4 (match pdbfile with | None -> 0 | Some f -> (24 + System.Text.Encoding.Unicode.GetByteCount(f) // See bug 748444 + debugDataJustInCase))) next - let debugEmbeddedPdbChunk,next = + let debugEmbeddedPdbChunk, next = let streamLength = match pdbOpt with - | Some (_,_,stream) -> int(stream.Length) + | Some (_, _, stream) -> int(stream.Length) | None -> 0 chunk (align 0x4 (match embeddedPDB with | true -> 8 + streamLength @@ -3799,9 +3799,9 @@ let writeBinaryAndReportMappings (outfile, #endif let nativeResourcesSize = nativeResources.Length - let nativeResourcesChunk,next = chunk nativeResourcesSize next + let nativeResourcesChunk, next = chunk nativeResourcesSize next - let dummydatap,next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next + let dummydatap, next = chunk (if next = dataSectionAddr then 0x01 else 0x0) next let dataSectionSize = next - dataSectionAddr let nextPhys = align alignPhys (dataSectionPhysLoc + dataSectionSize) @@ -3811,7 +3811,7 @@ let writeBinaryAndReportMappings (outfile, // .RELOC SECTION base reloc table: 0x0c size let relocSectionPhysLoc = nextPhys let relocSectionAddr = next - let baseRelocTableChunk,next = chunk 0x0c next + let baseRelocTableChunk, next = chunk 0x0c next let relocSectionSize = next - relocSectionAddr let nextPhys = align alignPhys (relocSectionPhysLoc + relocSectionSize) @@ -3822,7 +3822,7 @@ let writeBinaryAndReportMappings (outfile, // references into the data section from the metadata tables. begin requiredDataFixups |> List.iter - (fun (metadataOffset32,(dataOffset,kind)) -> + (fun (metadataOffset32, (dataOffset, kind)) -> let metadataOffset = metadataOffset32 if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata"; checkFixup32 metadata metadataOffset 0xdeaddddd; @@ -4094,7 +4094,7 @@ let writeBinaryAndReportMappings (outfile, (if modul.Is32BitPreferred then 0x00020003 else 0x00) ||| (if (match signer with None -> false | Some s -> s.IsFullySigned) then 0x08 else 0x00) - let headerVersionMajor,headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion + let headerVersionMajor, headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion writePadding os "pad to cli header" cliHeaderPadding write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] @@ -4232,7 +4232,7 @@ let writeBinaryAndReportMappings (outfile, FileSystemUtilites.setExecutablePermission outfile with _ -> () - pdbData,pdbOpt,debugDirectoryChunk,debugDataChunk,debugEmbeddedPdbChunk,textV2P,mappings + pdbData, pdbOpt, debugDirectoryChunk, debugDataChunk, debugEmbeddedPdbChunk, textV2P, mappings // Looks like a finally with e -> diff --git a/src/absil/ilx.fs b/src/absil/ilx.fs index 7aa1f1cc1a..afe285ae73 100644 --- a/src/absil/ilx.fs +++ b/src/absil/ilx.fs @@ -49,13 +49,13 @@ type IlxUnionRef = type IlxUnionSpec = | IlxUnionSpec of IlxUnionRef * ILGenericArgs - member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(bx,tref,_,_,_),inst)) = x in mkILNamedTy bx tref inst - member x.Boxity = let (IlxUnionSpec(IlxUnionRef(bx,_,_,_,_),_)) = x in bx - member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),_)) = x in tref - member x.GenericArgs = let (IlxUnionSpec(_,inst)) = x in inst - member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_,_,alts,_,_),_)) = x in alts - member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_,_,_,np,_),_)) = x in np - member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_,_,_,_,b),_)) = x in b + member x.EnclosingType = let (IlxUnionSpec(IlxUnionRef(bx, tref, _, _, _), inst)) = x in mkILNamedTy bx tref inst + member x.Boxity = let (IlxUnionSpec(IlxUnionRef(bx, _, _, _, _), _)) = x in bx + member x.TypeRef = let (IlxUnionSpec(IlxUnionRef(_, tref, _, _, _), _)) = x in tref + member x.GenericArgs = let (IlxUnionSpec(_, inst)) = x in inst + member x.AlternativesArray = let (IlxUnionSpec(IlxUnionRef(_, _, alts, _, _), _)) = x in alts + member x.IsNullPermitted = let (IlxUnionSpec(IlxUnionRef(_, _, _, np, _), _)) = x in np + member x.HasHelpers = let (IlxUnionSpec(IlxUnionRef(_, _, _, _, b), _)) = x in b member x.Alternatives = Array.toList x.AlternativesArray member x.Alternative idx = x.AlternativesArray.[idx] member x.FieldDef idx fidx = x.Alternative(idx).FieldDef(fidx) @@ -72,15 +72,15 @@ type IlxClosureApps = | Apps_done of ILType let rec instAppsAux n inst = function - Apps_tyapp (ty,rty) -> Apps_tyapp(instILTypeAux n inst ty, instAppsAux n inst rty) - | Apps_app (dty,rty) -> Apps_app(instILTypeAux n inst dty, instAppsAux n inst rty) + Apps_tyapp (ty, rty) -> Apps_tyapp(instILTypeAux n inst ty, instAppsAux n inst rty) + | Apps_app (dty, rty) -> Apps_app(instILTypeAux n inst dty, instAppsAux n inst rty) | Apps_done rty -> Apps_done(instILTypeAux n inst rty) let rec instLambdasAux n inst = function - | Lambdas_forall (b,rty) -> + | Lambdas_forall (b, rty) -> Lambdas_forall(b, instLambdasAux n inst rty) - | Lambdas_lambda (p,rty) -> - Lambdas_lambda({ p with Type=instILTypeAux n inst p.Type},instLambdasAux n inst rty) + | Lambdas_lambda (p, rty) -> + Lambdas_lambda({ p with Type=instILTypeAux n inst p.Type}, instLambdasAux n inst rty) | Lambdas_return rty -> Lambdas_return(instILTypeAux n inst rty) let instLambdas i t = instLambdasAux 0 i t @@ -90,7 +90,7 @@ type IlxClosureFreeVar = fvCompilerGenerated:bool fvType: ILType } -let mkILFreeVar (name,compgen,ty) = +let mkILFreeVar (name, compgen, ty) = { fvName=name fvCompilerGenerated=compgen fvType=ty } @@ -101,19 +101,19 @@ type IlxClosureRef = type IlxClosureSpec = | IlxClosureSpec of IlxClosureRef * ILGenericArgs * ILType - member x.TypeRef = let (IlxClosureRef(tref,_,_)) = x.ClosureRef in tref - member x.ILType = let (IlxClosureSpec(_,_,ty)) = x in ty - member x.ClosureRef = let (IlxClosureSpec(cloref,_,_)) = x in cloref - member x.FormalFreeVars = let (IlxClosureRef(_,_,fvs)) = x.ClosureRef in fvs - member x.FormalLambdas = let (IlxClosureRef(_,lambdas,_)) = x.ClosureRef in lambdas - member x.GenericArgs = let (IlxClosureSpec(_,inst,_)) = x in inst + member x.TypeRef = let (IlxClosureRef(tref, _, _)) = x.ClosureRef in tref + member x.ILType = let (IlxClosureSpec(_, _, ty)) = x in ty + member x.ClosureRef = let (IlxClosureSpec(cloref, _, _)) = x in cloref + member x.FormalFreeVars = let (IlxClosureRef(_, _, fvs)) = x.ClosureRef in fvs + member x.FormalLambdas = let (IlxClosureRef(_, lambdas, _)) = x.ClosureRef in lambdas + member x.GenericArgs = let (IlxClosureSpec(_, inst, _)) = x in inst static member Create (cloref, inst) = - let (IlxClosureRef(tref,_,_)) = cloref + let (IlxClosureRef(tref, _, _)) = cloref IlxClosureSpec(cloref, inst, mkILBoxedType (mkILTySpec (tref, inst))) member clospec.Constructor = let cloTy = clospec.ILType let fields = clospec.FormalFreeVars - mkILCtorMethSpecForTy (cloTy,fields |> Array.map (fun fv -> fv.fvType) |> Array.toList) + mkILCtorMethSpecForTy (cloTy, fields |> Array.map (fun fv -> fv.fvType) |> Array.toList) // Define an extension of the IL algebra of type definitions @@ -141,7 +141,7 @@ type IlxUnionInfo = // Define these as extensions of the IL types // -------------------------------------------------------------------- -let destTyFuncApp = function Apps_tyapp (b,c) -> b,c | _ -> failwith "destTyFuncApp" +let destTyFuncApp = function Apps_tyapp (b, c) -> b, c | _ -> failwith "destTyFuncApp" let mkILFormalCloRef gparams csig = IlxClosureSpec.Create(csig, mkILFormalGenericArgs 0 gparams) diff --git a/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs b/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs index b658d62627..c74e002c1b 100644 --- a/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs +++ b/src/assemblyinfo/assemblyinfo.FSharp.Compiler.Private.dll.fs @@ -46,6 +46,7 @@ open System.Runtime.InteropServices [] [] [] +[] #endif #if STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY [] diff --git a/src/buildfromsource.cmd b/src/buildfromsource.cmd index 03d44c5b56..b18f616f0c 100644 --- a/src/buildfromsource.cmd +++ b/src/buildfromsource.cmd @@ -18,9 +18,9 @@ dotnet publish %__scriptpath%buildtools\fsyacc\fsyacc.fsproj -o %__scriptpath%. if ERRORLEVEL 1 echo Error: failed && goto :failure rem build and pack tools -dotnet restore %__scriptpath%fsharp\FSharp.Compiler.nuget\FSharp.Compiler.nuget.BuildFromSource.fsproj +dotnet restore %__scriptpath%buildfromsource\FSharp.Compiler.nuget\FSharp.Compiler.nuget.fsproj if ERRORLEVEL 1 echo Error: failed && goto :failure -dotnet pack %__scriptpath%fsharp\FSharp.Compiler.nuget\FSharp.Compiler.nuget.BuildFromSource.fsproj -c debug +dotnet pack %__scriptpath%buildfromsource\FSharp.Compiler.nuget\FSharp.Compiler.nuget.fsproj -c debug if ERRORLEVEL 1 echo Error: failed && goto :failure goto :success diff --git a/src/buildfromsource.sh b/src/buildfromsource.sh index 64f0a11f45..ac21542c30 100755 --- a/src/buildfromsource.sh +++ b/src/buildfromsource.sh @@ -11,15 +11,15 @@ dotnet restore $__scriptpath/buildtools/fsyacc/fsyacc.fsproj dotnet publish $__scriptpath/buildtools/fsyacc/fsyacc.fsproj -o $__scriptpath/../Tools/fsyacc # build tools -dotnet restore $__scriptpath/fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj -dotnet publish $__scriptpath/fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj +dotnet restore $__scriptpath/buildfromsource/FSharp.Build/FSharp.Build.fsproj +dotnet publish $__scriptpath/buildfromsource/FSharp.Build/FSharp.Build.fsproj -dotnet restore $__scriptpath/fsharp/fsi/Fsi.BuildFromSource.fsproj -dotnet publish fsharp/fsi/Fsi.BuildFromSource.fsproj +dotnet restore $__scriptpath/buildfromsource/Fsi/Fsi.fsproj +dotnet publish $__scriptpath/buildfromsource/Fsi/Fsi.fsproj -dotnet restore $__scriptpath/fsharp/Fsc/Fsc.BuildFromSource.fsproj -dotnet publish $__scriptpath/fsharp/Fsc/Fsc.BuildFromSource.fsproj +dotnet restore $__scriptpath/buildfromsource/Fsc/Fsc.fsproj +dotnet publish $__scriptpath/buildfromsource/Fsc/Fsc.fsproj # build and pack tools -dotnet restore $__scriptpath/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj -dotnet pack $__scriptpath/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj -c release +dotnet restore $__scriptpath/buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj +dotnet pack $__scriptpath/buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj -c release diff --git a/src/FSharpSource.BuildFromSource.targets b/src/buildfromsource/BuildFromSource.targets similarity index 89% rename from src/FSharpSource.BuildFromSource.targets rename to src/buildfromsource/BuildFromSource.targets index aff873c491..de0a43a4d9 100644 --- a/src/FSharpSource.BuildFromSource.targets +++ b/src/buildfromsource/BuildFromSource.targets @@ -4,7 +4,8 @@ 4.4.1.0 - $(MSBuildThisFileDirectory)../BuildFromSource/$(Configuration)/bin + $(MSBuildThisFileDirectory)../../BuildFromSource/$(Configuration)/bin + $(MSBuildThisFileDirectory).. true true @@ -12,15 +13,15 @@ $(DefineConstants);STRONG_NAME_AND_DELAY_SIGN_FSHARP_COMPILER_WITH_MSFT_KEY - $(MSBuildThisFileDirectory)buildtools/keys/MSFT.snk + $(MSBuildThisFileDirectory)../buildtools/keys/MSFT.snk true $(OtherFlags) --publicsign --keyfile:$(KeyFile) $(OtherFlags) --nocopyfsharpcore dotnet dotnet.exe - $(MSBuildThisFileDirectory)../Tools/dotnet20/$(DotNetExe) - $(MSBuildBinPath)/../../$(DotNetExe) + + $(DotNetExe) $(IntermediateOutputFile)\BuildVersionFile.props @@ -32,7 +33,7 @@ net40 - + - $(MSBuildThisFileDirectory)../Tools/fssrgen/fssrgen.dll + $(MSBuildThisFileDirectory)../../Tools/fssrgen/fssrgen.dll @@ -110,7 +111,7 @@ BeforeTargets="CoreCompile"> - $(MSBuildThisFileDirectory)../Tools/fslex/fslex.dll + $(MSBuildThisFileDirectory)../../Tools/fslex/fslex.dll @@ -133,7 +134,7 @@ BeforeTargets="CoreCompile"> - $(MSBuildThisFileDirectory)../Tools/fsyacc/fsyacc.dll + $(MSBuildThisFileDirectory)../../Tools/fsyacc/fsyacc.dll diff --git a/src/fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj b/src/buildfromsource/FSharp.Build/FSharp.Build.fsproj similarity index 63% rename from src/fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj rename to src/buildfromsource/FSharp.Build/FSharp.Build.fsproj index 58670adc78..c65905b221 100644 --- a/src/fsharp/FSharp.Build/FSharp.Build.BuildFromSource.fsproj +++ b/src/buildfromsource/FSharp.Build/FSharp.Build.fsproj @@ -12,34 +12,35 @@ $(OtherFlags) --maxerrors:20 --extraoptimizationloops:1 - + - - + + - - - - - - + + + + + + + Microsoft.FSharp.Targets {BuildSuffix} - + Microsoft.Portable.FSharp.Targets {BuildSuffix} - + Microsoft.FSharp.NetSdk.props {BuildSuffix} - + Microsoft.FSharp.NetSdk.targets {BuildSuffix} @@ -47,7 +48,7 @@ - + diff --git a/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.BuildFromSource.fsproj b/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj similarity index 70% rename from src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.BuildFromSource.fsproj rename to src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj index c05e016cb3..e4c513f5e5 100644 --- a/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.BuildFromSource.fsproj +++ b/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj @@ -13,20 +13,20 @@ $(OtherFlags) --warnon:1182 --maxerrors:20 --extraoptimizationloops:1 - + - - + + - - - + + + - + diff --git a/src/buildfromsource/FSharp.Compiler.Private/.gitignore b/src/buildfromsource/FSharp.Compiler.Private/.gitignore new file mode 100644 index 0000000000..fa6bb93f54 --- /dev/null +++ b/src/buildfromsource/FSharp.Compiler.Private/.gitignore @@ -0,0 +1,9 @@ +illex.fs +ilpars.fs +ilpars.fsi +lex.fs +pars.fs +pars.fsi +pplex.fs +pppars.fs +pppars.fsi diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.BuildFromSource.fsproj b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj similarity index 67% rename from src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.BuildFromSource.fsproj rename to src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 75b2fac99e..1cc973ee6b 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.BuildFromSource.fsproj +++ b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -12,6 +12,7 @@ $(OtherFlags) --warnon:1182 --maxerrors:20 --extraoptimizationloops:1 + $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl @@ -22,10 +23,10 @@ assemblyinfo.FSharp.Compiler.Private.dll.fs - + FSComp.txt - + FSStrings.resx @@ -40,10 +41,10 @@ ErrorText\sformat.fs - + ErrorText\sr.fsi - + ErrorText\sr.fs @@ -112,37 +113,37 @@ Utilities\bytes.fs - + Utilities\InternalCollections.fsi - + Utilities\InternalCollections.fs - + Utilities\QueueList.fs - + Utilities\lib.fs - + Utilities\rational.fsi - + Utilities\rational.fs - + ErrorLogging\range.fsi - + ErrorLogging\range.fs - + ErrorLogging\ErrorLogger.fs - + ErrorLogging\ErrorResolutionHints.fs - + ReferenceResolution\ReferenceResolver.fs @@ -228,7 +229,7 @@ CompilerLocation\CompilerLocationUtils.fs - + PrettyNaming\PrettyNaming.fs @@ -246,35 +247,35 @@ ILXErase\EraseUnions.fs - + --unicode --lexlib Internal.Utilities.Text.Lexing ParserAndUntypedAST\pplex.fsl - + --module Microsoft.FSharp.Compiler.PPParser --open Microsoft.FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing ParserAndUntypedAST\pppars.fsy - + --unicode --lexlib Internal.Utilities.Text.Lexing ParserAndUntypedAST\lex.fsl - + --module Microsoft.FSharp.Compiler.Parser --open Microsoft.FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing ParserAndUntypedAST\pars.fsy - + ParserAndUntypedAST\UnicodeLexing.fsi - + ParserAndUntypedAST\UnicodeLexing.fs - + ParserAndUntypedAST\layout.fsi - + ParserAndUntypedAST\layout.fs - + ParserAndUntypedAST\ast.fs @@ -283,10 +284,10 @@ ParserAndUntypedAST\pars.fs - + ParserAndUntypedAST\lexhelp.fsi - + ParserAndUntypedAST\lexhelp.fs @@ -295,320 +296,320 @@ ParserAndUntypedAST\lex.fs - + ParserAndUntypedAST\lexfilter.fs - + TypedAST\tainted.fsi - + TypedAST\tainted.fs - + TypedAST\ExtensionTyping.fsi - + TypedAST\ExtensionTyping.fs - + TypedAST\QuotationPickler.fsi - + TypedAST\QuotationPickler.fs - + TypedAST\tast.fs - + TypedAST\TcGlobals.fs - + TypedAST\TastOps.fsi - + TypedAST\TastOps.fs - + TypedAST\TastPickle.fsi - + TypedAST\TastPickle.fs - + Logic\import.fsi - + Logic\import.fs - + Logic\infos.fs - + Logic\AccessibilityLogic.fs - + Logic\AttributeChecking.fs - + Logic\InfoReader.fs - + Logic\NicePrint.fs - + Logic\AugmentWithHashCompare.fsi - + Logic\AugmentWithHashCompare.fs - + Logic\NameResolution.fsi - + Logic\NameResolution.fs - + Logic\TypeRelations.fs - + Logic\SignatureConformance.fs - + Logic\MethodOverrides.fs - + Logic\MethodCalls.fs - + Logic\PatternMatchCompilation.fsi - + Logic\PatternMatchCompilation.fs - + Logic\ConstraintSolver.fsi - + Logic\ConstraintSolver.fs - + Logic\CheckFormatStrings.fsi - + Logic\CheckFormatStrings.fs - + Logic\FindUnsolved.fs - + Logic\QuotationTranslator.fsi - + Logic\QuotationTranslator.fs - + Logic\PostInferenceChecks.fsi - + Logic\PostInferenceChecks.fs - + Logic\TypeChecker.fsi - + Logic\TypeChecker.fs - + Optimize\Optimizer.fsi - + Optimize\Optimizer.fs - + Optimize\DetupleArgs.fsi - + Optimize\DetupleArgs.fs - + Optimize\InnerLambdasToTopLevelFuncs.fsi - + Optimize\InnerLambdasToTopLevelFuncs.fs - + Optimize\LowerCallsAndSeqs.fs - + Optimize\autobox.fs - + CodeGen\IlxGen.fsi - + CodeGen\IlxGen.fs - + Driver\CompileOps.fsi - + Driver\CompileOps.fs - + Driver\CompileOptions.fsi - + Driver\CompileOptions.fs - + Driver\fsc.fsi - + Driver\fsc.fs - + Symbols/SymbolHelpers.fsi - + Symbols/SymbolHelpers.fs - + Symbols/Symbols.fsi - + Symbols/Symbols.fs - + Symbols/Exprs.fsi - + Symbols/Exprs.fs - + Service/IncrementalBuild.fsi - + Service/IncrementalBuild.fs - + Service/Reactor.fsi - + Service/Reactor.fs - + Service/ServiceConstants.fs - + Service/ServiceDeclarationLists.fsi - + Service/ServiceDeclarationLists.fs - + Service/ServiceLexing.fsi - + Service/ServiceLexing.fs - + Service/ServiceParseTreeWalk.fs - + Service/ServiceNavigation.fsi - + Service/ServiceNavigation.fs - + Service/ServiceParamInfoLocations.fsi - + Service/ServiceParamInfoLocations.fs - + Service/ServiceUntypedParse.fsi - + Service/ServiceUntypedParse.fs - + Service/ServiceAssemblyContent.fsi - + Service/ServiceAssemblyContent.fs - + Service/ServiceXmlDocParser.fsi - + Service/ServiceXmlDocParser.fs Service/reshapedmsbuild.fs - + Service/SimulatedMSBuildReferenceResolver.fs - + Service/ExternalSymbol.fsi - + Service/ExternalSymbol.fs - + Service/service.fsi - + Service/service.fs - + Service/ServiceInterfaceStubGenerator.fsi - + Service/ServiceInterfaceStubGenerator.fs - + Service/ServiceStructure.fsi - + Service/ServiceStructure.fs - + FSIstrings.txt - + InteractiveSession\fsi.fsi - + InteractiveSession\fsi.fs - + Misc/InternalsVisibleTo.fs - + Misc/MSBuildReferenceResolver.fs - + Misc/LegacyHostedCompilerForTesting.fs - + - - + + diff --git a/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj b/src/buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj similarity index 87% rename from src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj rename to src/buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj index cc92bb5e4b..29a35faa0b 100644 --- a/src/fsharp/FSharp.Compiler.nuget/FSharp.Compiler.nuget.BuildFromSource.fsproj +++ b/src/buildfromsource/FSharp.Compiler.nuget/FSharp.Compiler.nuget.fsproj @@ -12,7 +12,7 @@ $(OtherFlags) --warnon:1182 --maxerrors:20 - + $([System.DateTime]::Now.ToString(`yyMMdd`)) @@ -26,14 +26,14 @@ - Microsoft.FSharp.Compiler.nuspec + $(FSharpSourcesRoot)\fsharp\FSharp.Compiler.nuget\Microsoft.FSharp.Compiler.nuspec licenseUrl=$(PackageLicenceUrl);version=$(PackageVersion);authors=$(PackageAuthors);projectUrl=$(PackageProjectUrl);tags=$(PackageTags) $(OutputPath)/$(TargetFramework) - - + + diff --git a/src/fsharp/FSharp.Core/FSharp.Core.BuildFromSource.fsproj b/src/buildfromsource/FSharp.Core/FSharp.Core.fsproj similarity index 66% rename from src/fsharp/FSharp.Core/FSharp.Core.BuildFromSource.fsproj rename to src/buildfromsource/FSharp.Core/FSharp.Core.fsproj index 95a3210751..a6f1230691 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.BuildFromSource.fsproj +++ b/src/buildfromsource/FSharp.Core/FSharp.Core.fsproj @@ -12,130 +12,132 @@ $(DefineConstants);FSHARP_CORE;BUILD_FROM_SOURCE $(OtherFlags) --warnon:1182 --compiling-fslib --compiling-fslib-40 --maxerrors:20 --extraoptimizationloops:1 - - + + + $(FSharpSourcesRoot)\fsharp\FSharp.Core + - + FSCore.resx - + Primitives/prim-types-prelude.fsi - + Primitives/prim-types-prelude.fs - + Primitives/SR.fs - + Primitives/prim-types.fsi - + Primitives/prim-types.fs - + Collections/local.fsi - + Collections/local.fs - + Collections/array2.fsi - + Collections/array2.fs - + Collections/option.fsi - + Collections/option.fs - + Collections/result.fsi - + Collections/result.fs - + Collections/collections.fsi - + Collections/collections.fs - + Collections/seqcore.fsi - + Collections/seqcore.fs - + Collections/seq.fsi - + Collections/seq.fs - + Collections/string.fsi - + Collections/string.fs - + Collections/list.fsi - + Collections/list.fs - + Collections/array.fsi - + Collections/array.fs - + Collections/array3.fsi - + Collections/array3.fs - + Collections/map.fsi - + Collections/map.fs - + Collections/set.fsi - + Collections/set.fs Reflection/reshapedreflection.fs - + Reflection/reflect.fsi - + Reflection/reflect.fs - + Event/event.fsi - + Event/event.fs - + Numerics/n.fsi - + Numerics/n.fs - + Numerics/z.fsi - + Numerics/z.fs @@ -144,55 +146,55 @@ Printf/sformat.fs - + Printf/printf.fsi - + Printf/printf.fs - + Quotations/quotations.fsi - + Quotations/quotations.fs - + NativeInterop/nativeptr.fsi - + NativeInterop/nativeptr.fs - + Async/control.fsi - + Async/control.fs - + Queries/Linq.fsi - + Queries/Linq.fs - + Queries/MutableTuple.fs - + Queries/QueryExtensions.fs - + Queries/Query.fsi - + Queries/Query.fs - + Units/SI.fs - + Extras/fslib-extra-pervasives.fsi - + Extras/fslib-extra-pervasives.fs diff --git a/src/fsharp/Fsc/Fsc.BuildFromSource.fsproj b/src/buildfromsource/Fsc/Fsc.fsproj similarity index 75% rename from src/fsharp/Fsc/Fsc.BuildFromSource.fsproj rename to src/buildfromsource/Fsc/Fsc.fsproj index 9a04c0229a..e17e6da9e4 100644 --- a/src/fsharp/Fsc/Fsc.BuildFromSource.fsproj +++ b/src/buildfromsource/Fsc/Fsc.fsproj @@ -13,19 +13,16 @@ $(OtherFlags) --maxerrors:20 --extraoptimizationloops:1 - + - + Resources/assemblyinfo.fsc.exe.fs - + fscmain.fs - - fsc.exe.config - PreserveNewest - + default.win32manifest PreserveNewest @@ -33,9 +30,9 @@ - - - + + + diff --git a/src/fsharp/fsi/Fsi.BuildFromSource.fsproj b/src/buildfromsource/Fsi/Fsi.fsproj similarity index 76% rename from src/fsharp/fsi/Fsi.BuildFromSource.fsproj rename to src/buildfromsource/Fsi/Fsi.fsproj index f94903db32..d06056fe09 100644 --- a/src/fsharp/fsi/Fsi.BuildFromSource.fsproj +++ b/src/buildfromsource/Fsi/Fsi.fsproj @@ -10,34 +10,34 @@ $(NoWarn);45;55;62;75;1204 true $(DefineConstants);BUILD_FROM_SOURCE;COMPILER;EXTENSIONTYPING - fsi.res $(OtherFlags) --warnon:1182 --maxerrors:20 --extraoptimizationloops:1 - + + + $(FSharpSourcesRoot)\fsharp\fsi + $(FsiDir)\fsi.res + assemblyinfo.fsi.exe.fs - + console.fs - + fsimain.fs - - PreserveNewest - fsi.exe.config - + - - - - - + + + + + diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 45d6e3e78c..21251bd24e 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -4,6 +4,7 @@ module internal Microsoft.FSharp.Compiler.CompileOps open System +open System.Diagnostics open System.Text open System.IO open System.Collections.Generic @@ -1076,9 +1077,9 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = | Parser.TOKEN_CONST -> getErrorString("Parser.TOKEN.CONST") | Parser.TOKEN_FIXED -> getErrorString("Parser.TOKEN.FIXED") | unknown -> - System.Diagnostics.Debug.Assert(false, "unknown token tag") + Debug.Assert(false, "unknown token tag") let result = sprintf "%+A" unknown - System.Diagnostics.Debug.Assert(false, result) + Debug.Assert(false, result) result match ctxt.CurrentToken with @@ -2001,9 +2002,15 @@ let ResolveFileUsingPaths(paths, m, name) = raise (FileNameNotResolved(name, searchMessage, m)) let GetWarningNumber(m, s:string) = - try - Some (int32 s) - with err -> + try + // Okay so ... + // #pragma strips FS of the #pragma "FS0004" and validates the warning number + // therefore if we have warning id that starts with a numeric digit we convert it to Some (int32) + // anything else is ignored None + if Char.IsDigit(s.[0]) then Some (int32 s) + elif s.StartsWith("FS", StringComparison.Ordinal) = true then raise (new ArgumentException()) + else None + with err -> warning(Error(FSComp.SR.buildInvalidWarningNumber(s), m)) None @@ -2195,12 +2202,7 @@ type TcConfigBuilder = mutable useHighEntropyVA : bool mutable inputCodePage: int option mutable embedResources : string list - mutable globalWarnAsError: bool - mutable globalWarnLevel: int - mutable specificWarnOff: int list - mutable specificWarnOn: int list - mutable specificWarnAsError: int list - mutable specificWarnAsWarn : int list + mutable errorSeverityOptions: FSharpErrorSeverityOptions mutable mlCompatibility: bool mutable checkOverflow: bool mutable showReferenceResolutions:bool @@ -2324,55 +2326,47 @@ type TcConfigBuilder = mutable shadowCopyReferences : bool } - static member CreateNew (legacyReferenceResolver, defaultFSharpBinariesDir, optimizeForMemory, implicitIncludeDir, isInteractive, isInvalidationSupported, defaultCopyFSharpCore) = - System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) - if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then - failwith "Expected a valid defaultFSharpBinariesDir" - { + static member Initial = + { #if COMPILER_SERVICE_ASSUMES_DOTNETCORE_COMPILATION primaryAssembly = PrimaryAssembly.System_Runtime // defaut value, can be overridden using the command line switch #else primaryAssembly = PrimaryAssembly.Mscorlib // defaut value, can be overridden using the command line switch #endif light = None - noFeedback=false - stackReserveSize=None - conditionalCompilationDefines=[] - implicitIncludeDir = implicitIncludeDir + noFeedback = false + stackReserveSize = None + conditionalCompilationDefines = [] + implicitIncludeDir = String.Empty autoResolveOpenDirectivesToDlls = false openBinariesInMemory = false - openDebugInformationForLaterStaticLinking=false - defaultFSharpBinariesDir=defaultFSharpBinariesDir - compilingFslib=false - compilingFslib20=None - compilingFslib40=false - compilingFslibNoBigInt=false - useIncrementalBuilder=false - useFsiAuxLib=false - implicitOpens=[] - includes=[] - resolutionEnvironment=ResolutionEnvironment.EditingOrCompilation false - framework=true - implicitlyResolveAssemblies=true + openDebugInformationForLaterStaticLinking = false + defaultFSharpBinariesDir = String.Empty + compilingFslib = false + compilingFslib20 = None + compilingFslib40 = false + compilingFslibNoBigInt = false + useIncrementalBuilder = false + useFsiAuxLib = false + implicitOpens = [] + includes = [] + resolutionEnvironment = ResolutionEnvironment.EditingOrCompilation false + framework = true + implicitlyResolveAssemblies = true referencedDLLs = [] projectReferences = [] knownUnresolvedReferences = [] loadedSources = [] - globalWarnAsError=false - globalWarnLevel=3 - specificWarnOff=[] - specificWarnOn=[] - specificWarnAsError=[] - specificWarnAsWarn=[] + errorSeverityOptions = FSharpErrorSeverityOptions.Default embedResources = [] - inputCodePage=None - optimizeForMemory=optimizeForMemory + inputCodePage = None + optimizeForMemory = true subsystemVersion = 4, 0 // per spec for 357994 useHighEntropyVA = false - mlCompatibility=false - checkOverflow=false - showReferenceResolutions=false - outputFile=None + mlCompatibility = false + checkOverflow = false + showReferenceResolutions = false + outputFile = None platform = None prefer32Bit = false useSimpleResolution = runningOnMono @@ -2426,8 +2420,8 @@ type TcConfigBuilder = win32manifest = "" includewin32manifest = true linkResources = [] - legacyReferenceResolver = legacyReferenceResolver - showFullPaths =false + legacyReferenceResolver = null + showFullPaths = false errorStyle = ErrorStyle.DefaultErrors utf8output = false @@ -2436,14 +2430,14 @@ type TcConfigBuilder = #if DEBUG showOptimizationData = false #endif - showTerms = false - writeTermsToFiles = false + showTerms = false + writeTermsToFiles = false - doDetuple = false - doTLR = false + doDetuple = false + doTLR = false doFinalSimplify = false - optsOn = false - optSettings = Optimizer.OptimizationSettings.Defaults + optsOn = false + optSettings = Optimizer.OptimizationSettings.Defaults emitTailcalls = true deterministic = false #if PREFERRED_UI_LANG @@ -2451,9 +2445,9 @@ type TcConfigBuilder = #endif lcid = None // See bug 6071 for product banner spec - productNameForBannerText = (FSComp.SR.buildProductName(FSharpEnvironment.FSharpBannerVersion)) - showBanner = true - showTimes = false + productNameForBannerText = FSComp.SR.buildProductName(FSharpEnvironment.FSharpBannerVersion) + showBanner = true + showTimes = false showLoadedAssemblies = false continueAfterParseFailure = false #if EXTENSIONTYPING @@ -2462,17 +2456,32 @@ type TcConfigBuilder = pause = false alwaysCallVirt = true noDebugData = false - isInteractive = isInteractive - isInvalidationSupported = isInvalidationSupported + isInteractive = false + isInvalidationSupported = false sqmSessionGuid = None sqmNumOfSourceFiles = 0 sqmSessionStartedTime = System.DateTime.Now.Ticks emitDebugInfoInQuotations = false exename = None - copyFSharpCore = defaultCopyFSharpCore + copyFSharpCore = false shadowCopyReferences = false } + static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, optimizeForMemory, implicitIncludeDir, + isInteractive, isInvalidationSupported, defaultCopyFSharpCore) = + Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) + if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then + failwith "Expected a valid defaultFSharpBinariesDir" + { TcConfigBuilder.Initial with + implicitIncludeDir = implicitIncludeDir + defaultFSharpBinariesDir = defaultFSharpBinariesDir + optimizeForMemory = optimizeForMemory + legacyReferenceResolver = legacyReferenceResolver + isInteractive = isInteractive + isInvalidationSupported = isInvalidationSupported + copyFSharpCore = defaultCopyFSharpCore + } + member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter ResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom], m, nm) @@ -2520,7 +2529,8 @@ type TcConfigBuilder = | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- true - tcConfigB.specificWarnOff <- ListSet.insert (=) n tcConfigB.specificWarnOff + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with WarnOff = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOff } member tcConfigB.TurnWarningOn(m, s:string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter @@ -2529,7 +2539,8 @@ type TcConfigBuilder = | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- false - tcConfigB.specificWarnOn <- ListSet.insert (=) n tcConfigB.specificWarnOn + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with WarnOn = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOn } member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path @@ -2827,12 +2838,7 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = member x.useHighEntropyVA = data.useHighEntropyVA member x.inputCodePage = data.inputCodePage member x.embedResources = data.embedResources - member x.globalWarnAsError = data.globalWarnAsError - member x.globalWarnLevel = data.globalWarnLevel - member x.specificWarnOff = data. specificWarnOff - member x.specificWarnOn = data. specificWarnOn - member x.specificWarnAsError = data.specificWarnAsError - member x.specificWarnAsWarn = data.specificWarnAsWarn + member x.errorSeverityOptions = data.errorSeverityOptions member x.mlCompatibility = data.mlCompatibility member x.checkOverflow = data.checkOverflow member x.showReferenceResolutions = data.showReferenceResolutions @@ -3276,15 +3282,14 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = member tcConfig.CoreLibraryDllReference() = fslibReference -let ReportWarning (globalWarnLevel : int, specificWarnOff : int list, specificWarnOn : int list) err = - let n = GetDiagnosticNumber err - warningOn err globalWarnLevel specificWarnOn && not (List.contains n specificWarnOff) +let ReportWarning options err = + warningOn err (options.WarnLevel) (options.WarnOn) && not (List.contains (GetDiagnosticNumber err) (options.WarnOff)) -let ReportWarningAsError (globalWarnLevel : int, specificWarnOff : int list, specificWarnOn : int list, specificWarnAsError : int list, specificWarnAsWarn : int list, globalWarnAsError : bool) err = - warningOn err globalWarnLevel specificWarnOn && - not (List.contains (GetDiagnosticNumber err) specificWarnAsWarn) && - ((globalWarnAsError && not (List.contains (GetDiagnosticNumber err) specificWarnOff)) || - List.contains (GetDiagnosticNumber err) specificWarnAsError) +let ReportWarningAsError options err = + warningOn err (options.WarnLevel) (options.WarnOn) && + not (List.contains (GetDiagnosticNumber err) (options.WarnAsWarn)) && + ((options.GlobalWarnAsError && not (List.contains (GetDiagnosticNumber err) options.WarnOff)) || + List.contains (GetDiagnosticNumber err) (options.WarnAsError)) //---------------------------------------------------------------------------- // Scoped #nowarn pragmas @@ -3768,7 +3773,7 @@ type ILResource with member r.GetByteReader(m) = match r.Location with | ILResourceLocation.Local b -> b - | _-> error(InternalError("UnpickleFromResource", m)) + | _-> error(InternalError("GetByteReader", m)) let MakeILResource rname bytes = { Name = rname @@ -3776,22 +3781,22 @@ let MakeILResource rname bytes = Access = ILResourceAccess.Public CustomAttrs = emptyILCustomAttrs } -let PickleToResource file g scope rname p x = +let PickleToResource inMem file g scope rname p x = { Name = rname - Location = (let bytes = pickleObjWithDanglingCcus file g scope p x in ILResourceLocation.Local (fun () -> bytes)) + Location = (let bytes = pickleObjWithDanglingCcus inMem file g scope p x in ILResourceLocation.Local (fun () -> bytes)) Access = ILResourceAccess.Public CustomAttrs = emptyILCustomAttrs } let GetSignatureData (file, ilScopeRef, ilModule, byteReader) : PickledDataWithReferences = unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo byteReader -let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: CcuThunk, file) : ILResource = +let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: CcuThunk, file, inMem) : ILResource = let mspec = ccu.Contents let mspec = ApplyExportRemappingToEntity tcGlobals exportRemapping mspec // For historical reasons, we use a different resource name for FSharp.Core, so older F# compilers // don't complain when they see the resource. let rname = if ccu.AssemblyName = GetFSharpCoreLibraryName() then FSharpSignatureDataResourceName2 else FSharpSignatureDataResourceName - PickleToResource file tcGlobals ccu (rname+ccu.AssemblyName) pickleCcuInfo + PickleToResource inMem file tcGlobals ccu (rname+ccu.AssemblyName) pickleCcuInfo { mspec=mspec compileTimeWorkingDir=tcConfig.implicitIncludeDir usesQuotations = ccu.UsesFSharp20PlusQuotations } @@ -3799,11 +3804,11 @@ let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: Ccu let GetOptimizationData (file, ilScopeRef, ilModule, byteReader) = unpickleObjWithDanglingCcus file ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo (byteReader()) -let WriteOptimizationData (tcGlobals, file, ccu: CcuThunk, modulInfo) = +let WriteOptimizationData (tcGlobals, file, inMem, ccu: CcuThunk, modulInfo) = // For historical reasons, we use a different resource name for FSharp.Core, so older F# compilers // don't complain when they see the resource. let rname = if ccu.AssemblyName = GetFSharpCoreLibraryName() then FSharpOptimizationDataResourceName2 else FSharpOptimizationDataResourceName - PickleToResource file tcGlobals ccu (rname+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo + PickleToResource inMem file tcGlobals ccu (rname+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo //---------------------------------------------------------------------------- // Abstraction for project reference @@ -5549,4 +5554,3 @@ let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobal let (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState = TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile - diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index e1e1429d24..c5f14dc8bc 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -31,7 +31,7 @@ open Microsoft.FSharp.Compiler.ExtensionTyping #if DEBUG module internal CompilerService = - val showAssertForUnexpectedException : bool ref + val showAssertForUnexpectedException: bool ref #endif //---------------------------------------------------------------------------- @@ -39,82 +39,82 @@ module internal CompilerService = //-------------------------------------------------------------------------- /// Signature file suffixes -val FSharpSigFileSuffixes : string list +val FSharpSigFileSuffixes: string list /// Implementation file suffixes -val FSharpImplFileSuffixes : string list +val FSharpImplFileSuffixes: string list /// Script file suffixes -val FSharpScriptFileSuffixes : string list +val FSharpScriptFileSuffixes: string list -val IsScript : string -> bool +val IsScript: string -> bool /// File suffixes where #light is the default -val FSharpLightSyntaxFileSuffixes : string list +val FSharpLightSyntaxFileSuffixes: string list /// Get the name used for FSharp.Core -val GetFSharpCoreLibraryName : unit -> string +val GetFSharpCoreLibraryName: unit -> string //---------------------------------------------------------------------------- // Parsing inputs //-------------------------------------------------------------------------- -val ComputeQualifiedNameOfFileFromUniquePath : range * string list -> Ast.QualifiedNameOfFile +val ComputeQualifiedNameOfFileFromUniquePath: range * string list -> Ast.QualifiedNameOfFile -val PrependPathToInput : Ast.Ident list -> Ast.ParsedInput -> Ast.ParsedInput +val PrependPathToInput: Ast.Ident list -> Ast.ParsedInput -> Ast.ParsedInput /// Checks if a module name is already given and deduplicates the name if needed. -val DeduplicateModuleName : Dictionary> -> Set -> string -> Ast.QualifiedNameOfFile -> Ast.QualifiedNameOfFile +val DeduplicateModuleName: Dictionary> -> Set -> string -> Ast.QualifiedNameOfFile -> Ast.QualifiedNameOfFile /// Checks if a ParsedInput is using a module name that was already given and deduplicates the name if needed. -val DeduplicateParsedInputModuleName : Dictionary> -> Ast.ParsedInput -> Ast.ParsedInput +val DeduplicateParsedInputModuleName: Dictionary> -> Ast.ParsedInput -> Ast.ParsedInput -val ParseInput : (UnicodeLexing.Lexbuf -> Parser.token) * ErrorLogger * UnicodeLexing.Lexbuf * string option * string * isLastCompiland:(bool * bool) -> Ast.ParsedInput +val ParseInput: (UnicodeLexing.Lexbuf -> Parser.token) * ErrorLogger * UnicodeLexing.Lexbuf * string option * string * isLastCompiland:(bool * bool) -> Ast.ParsedInput //---------------------------------------------------------------------------- // Error and warnings //-------------------------------------------------------------------------- /// Get the location associated with an error -val GetRangeOfDiagnostic : PhasedDiagnostic -> range option +val GetRangeOfDiagnostic: PhasedDiagnostic -> range option /// Get the number associated with an error -val GetDiagnosticNumber : PhasedDiagnostic -> int +val GetDiagnosticNumber: PhasedDiagnostic -> int /// Split errors into a "main" error and a set of associated errors -val SplitRelatedDiagnostics : PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagnostic list +val SplitRelatedDiagnostics: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagnostic list /// Output an error to a buffer -val OutputPhasedDiagnostic : StringBuilder -> PhasedDiagnostic -> flattenErrors: bool -> unit +val OutputPhasedDiagnostic: StringBuilder -> PhasedDiagnostic -> flattenErrors: bool -> unit /// Output an error or warning to a buffer -val OutputDiagnostic : implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool -> StringBuilder -> PhasedDiagnostic -> unit +val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * isError:bool -> StringBuilder -> PhasedDiagnostic -> unit /// Output extra context information for an error or warning to a buffer -val OutputDiagnosticContext : prefix:string -> fileLineFunction:(string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit +val OutputDiagnosticContext: prefix:string -> fileLineFunction:(string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit /// Part of LegacyHostedCompilerForTesting [] type DiagnosticLocation = - { Range : range - File : string - TextRepresentation : string - IsEmpty : bool } + { Range: range + File: string + TextRepresentation: string + IsEmpty: bool } /// Part of LegacyHostedCompilerForTesting [] type DiagnosticCanonicalInformation = - { ErrorNumber : int - Subcategory : string - TextRepresentation : string } + { ErrorNumber: int + Subcategory: string + TextRepresentation: string } /// Part of LegacyHostedCompilerForTesting [] type DiagnosticDetailedInfo = - { Location : DiagnosticLocation option - Canonical : DiagnosticCanonicalInformation - Message : string } + { Location: DiagnosticLocation option + Canonical: DiagnosticCanonicalInformation + Message: string } /// Part of LegacyHostedCompilerForTesting [] @@ -123,7 +123,7 @@ type Diagnostic = | Long of bool * DiagnosticDetailedInfo /// Part of LegacyHostedCompilerForTesting -val CollectDiagnostic : implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * warning:bool * PhasedDiagnostic -> seq +val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * warning:bool * PhasedDiagnostic -> seq //---------------------------------------------------------------------------- // Resolve assembly references @@ -145,37 +145,37 @@ exception HashLoadedScriptConsideredSource of range /// reference in FSharp.Compiler.Service. type IRawFSharpAssemblyData = /// The raw list AutoOpenAttribute attributes in the assembly - abstract GetAutoOpenAttributes : ILGlobals -> string list + abstract GetAutoOpenAttributes: ILGlobals -> string list /// The raw list InternalsVisibleToAttribute attributes in the assembly - abstract GetInternalsVisibleToAttributes : ILGlobals -> string list + abstract GetInternalsVisibleToAttributes: ILGlobals -> string list /// The raw IL module definition in the assembly, if any. This is not present for cross-project references /// in the language service - abstract TryGetRawILModule : unit -> ILModuleDef option - abstract HasAnyFSharpSignatureDataAttribute : bool - abstract HasMatchingFSharpSignatureDataAttribute : ILGlobals -> bool + abstract TryGetRawILModule: unit -> ILModuleDef option + abstract HasAnyFSharpSignatureDataAttribute: bool + abstract HasMatchingFSharpSignatureDataAttribute: ILGlobals -> bool /// The raw F# signature data in the assembly, if any - abstract GetRawFSharpSignatureData : range * ilShortAssemName: string * fileName: string -> (string * byte[]) list + abstract GetRawFSharpSignatureData: range * ilShortAssemName: string * fileName: string -> (string * byte[]) list /// The raw F# optimization data in the assembly, if any - abstract GetRawFSharpOptimizationData : range * ilShortAssemName: string * fileName: string -> (string * (unit -> byte[])) list + abstract GetRawFSharpOptimizationData: range * ilShortAssemName: string * fileName: string -> (string * (unit -> byte[])) list /// The table of type forwarders in the assembly - abstract GetRawTypeForwarders : unit -> ILExportedTypesAndForwarders + abstract GetRawTypeForwarders: unit -> ILExportedTypesAndForwarders /// The identity of the module - abstract ILScopeRef : ILScopeRef - abstract ILAssemblyRefs : ILAssemblyRef list - abstract ShortAssemblyName : string + abstract ILScopeRef: ILScopeRef + abstract ILAssemblyRefs: ILAssemblyRef list + abstract ShortAssemblyName: string type TimeStampCache = - new : defaultTimeStamp: DateTime -> TimeStampCache + new: defaultTimeStamp: DateTime -> TimeStampCache member GetFileTimeStamp: string -> DateTime member GetProjectReferenceTimeStamp: IProjectReference * CompilationThreadToken -> DateTime and IProjectReference = /// The name of the assembly file generated by the project - abstract FileName : string + abstract FileName: string /// Evaluate raw contents of the assembly file generated by the project - abstract EvaluateRawContents : CompilationThreadToken -> Cancellable + abstract EvaluateRawContents: CompilationThreadToken -> Cancellable /// Get the logical timestamp that would be the timestamp of the assembly file generated by the project. /// @@ -185,25 +185,25 @@ and IProjectReference = /// /// The operation returns None only if it is not possible to create an IncrementalBuilder for the project at all, e.g. if there /// are fatal errors in the options for the project. - abstract TryGetLogicalTimeStamp : TimeStampCache * CompilationThreadToken -> System.DateTime option + abstract TryGetLogicalTimeStamp: TimeStampCache * CompilationThreadToken -> System.DateTime option type AssemblyReference = | AssemblyReference of range * string * IProjectReference option - member Range : range - member Text : string - member ProjectReference : IProjectReference option + member Range: range + member Text: string + member ProjectReference: IProjectReference option type AssemblyResolution = {/// The original reference to the assembly. - originalReference : AssemblyReference + originalReference: AssemblyReference /// Path to the resolvedFile - resolvedPath : string + resolvedPath: string /// Create the tooltip text for the assembly reference - prepareToolTip : unit -> string + prepareToolTip: unit -> string /// Whether or not this is an installed system assembly (for example, System.dll) - sysdir : bool + sysdir: bool // Lazily populated ilAssemblyRef for this reference. - ilAssemblyRef : ILAssemblyRef option ref } + ilAssemblyRef: ILAssemblyRef option ref } type UnresolvedAssemblyReference = UnresolvedAssemblyReference of string * AssemblyReference list @@ -216,7 +216,7 @@ type CompilerTarget = | ConsoleExe | Dll | Module - member IsExe : bool + member IsExe: bool type ResolveAssemblyReferenceMode = | Speculative @@ -231,11 +231,11 @@ type VersionFlag = | VersionString of string | VersionFile of string | VersionNone - member GetVersionInfo : implicitIncludeDir:string -> ILVersionInfo - member GetVersionString : implicitIncludeDir:string -> string + member GetVersionInfo: implicitIncludeDir:string -> ILVersionInfo + member GetVersionString: implicitIncludeDir:string -> string type TcConfigBuilder = - { mutable primaryAssembly : PrimaryAssembly + { mutable primaryAssembly: PrimaryAssembly mutable autoResolveOpenDirectivesToDlls: bool mutable noFeedback: bool mutable stackReserveSize: int32 option @@ -252,8 +252,8 @@ type TcConfigBuilder = mutable implicitOpens: string list mutable useFsiAuxLib: bool mutable framework: bool - mutable resolutionEnvironment : ReferenceResolver.ResolutionEnvironment - mutable implicitlyResolveAssemblies : bool + mutable resolutionEnvironment: ReferenceResolver.ResolutionEnvironment + mutable implicitlyResolveAssemblies: bool /// Set if the user has explicitly turned indentation-aware syntax on/off mutable light: bool option mutable conditionalCompilationDefines: string list @@ -261,117 +261,114 @@ type TcConfigBuilder = mutable loadedSources: (range * string) list mutable referencedDLLs: AssemblyReference list - mutable projectReferences : IProjectReference list - mutable knownUnresolvedReferences : UnresolvedAssemblyReference list + mutable projectReferences: IProjectReference list + mutable knownUnresolvedReferences: UnresolvedAssemblyReference list optimizeForMemory: bool - mutable subsystemVersion : int * int - mutable useHighEntropyVA : bool + mutable subsystemVersion: int * int + mutable useHighEntropyVA: bool mutable inputCodePage: int option - mutable embedResources : string list - mutable globalWarnAsError: bool - mutable globalWarnLevel: int - mutable specificWarnOff: int list - mutable specificWarnOn: int list - mutable specificWarnAsError: int list - mutable specificWarnAsWarn : int list + mutable embedResources: string list + mutable errorSeverityOptions: FSharpErrorSeverityOptions mutable mlCompatibility:bool mutable checkOverflow:bool mutable showReferenceResolutions:bool - mutable outputFile : string option - mutable platform : ILPlatform option - mutable prefer32Bit : bool - mutable useSimpleResolution : bool - mutable target : CompilerTarget - mutable debuginfo : bool - mutable testFlagEmitFeeFeeAs100001 : bool - mutable dumpDebugInfo : bool - mutable debugSymbolFile : string option - mutable typeCheckOnly : bool - mutable parseOnly : bool - mutable importAllReferencesOnly : bool - mutable simulateException : string option - mutable printAst : bool - mutable tokenizeOnly : bool - mutable testInteractionParser : bool - mutable reportNumDecls : bool - mutable printSignature : bool - mutable printSignatureFile : string - mutable xmlDocOutputFile : string option - mutable stats : bool - mutable generateFilterBlocks : bool - mutable signer : string option - mutable container : string option - mutable delaysign : bool - mutable publicsign : bool - mutable version : VersionFlag - mutable metadataVersion : string option - mutable standalone : bool - mutable extraStaticLinkRoots : string list - mutable noSignatureData : bool - mutable onlyEssentialOptimizationData : bool - mutable useOptimizationDataFile : bool - mutable jitTracking : bool - mutable portablePDB : bool - mutable embeddedPDB : bool - mutable embedAllSource : bool - mutable embedSourceList : string list - mutable sourceLink : string - mutable ignoreSymbolStoreSequencePoints : bool - mutable internConstantStrings : bool - mutable extraOptimizationIterations : int - mutable win32res : string - mutable win32manifest : string - mutable includewin32manifest : bool - mutable linkResources : string list + mutable outputFile: string option + mutable platform: ILPlatform option + mutable prefer32Bit: bool + mutable useSimpleResolution: bool + mutable target: CompilerTarget + mutable debuginfo: bool + mutable testFlagEmitFeeFeeAs100001: bool + mutable dumpDebugInfo: bool + mutable debugSymbolFile: string option + mutable typeCheckOnly: bool + mutable parseOnly: bool + mutable importAllReferencesOnly: bool + mutable simulateException: string option + mutable printAst: bool + mutable tokenizeOnly: bool + mutable testInteractionParser: bool + mutable reportNumDecls: bool + mutable printSignature: bool + mutable printSignatureFile: string + mutable xmlDocOutputFile: string option + mutable stats: bool + mutable generateFilterBlocks: bool + mutable signer: string option + mutable container: string option + mutable delaysign: bool + mutable publicsign: bool + mutable version: VersionFlag + mutable metadataVersion: string option + mutable standalone: bool + mutable extraStaticLinkRoots: string list + mutable noSignatureData: bool + mutable onlyEssentialOptimizationData: bool + mutable useOptimizationDataFile: bool + mutable jitTracking: bool + mutable portablePDB: bool + mutable embeddedPDB: bool + mutable embedAllSource: bool + mutable embedSourceList: string list + mutable sourceLink: string + mutable ignoreSymbolStoreSequencePoints: bool + mutable internConstantStrings: bool + mutable extraOptimizationIterations: int + mutable win32res: string + mutable win32manifest: string + mutable includewin32manifest: bool + mutable linkResources: string list mutable legacyReferenceResolver: ReferenceResolver.Resolver - mutable showFullPaths : bool - mutable errorStyle : ErrorStyle - mutable utf8output : bool - mutable flatErrors : bool - mutable maxErrors : int - mutable abortOnError : bool - mutable baseAddress : int32 option + mutable showFullPaths: bool + mutable errorStyle: ErrorStyle + mutable utf8output: bool + mutable flatErrors: bool + mutable maxErrors: int + mutable abortOnError: bool + mutable baseAddress: int32 option #if DEBUG - mutable showOptimizationData : bool + mutable showOptimizationData: bool #endif - mutable showTerms : bool - mutable writeTermsToFiles : bool - mutable doDetuple : bool - mutable doTLR : bool - mutable doFinalSimplify : bool - mutable optsOn : bool - mutable optSettings : Optimizer.OptimizationSettings - mutable emitTailcalls : bool - mutable deterministic : bool + mutable showTerms : bool + mutable writeTermsToFiles: bool + mutable doDetuple : bool + mutable doTLR : bool + mutable doFinalSimplify: bool + mutable optsOn : bool + mutable optSettings : Optimizer.OptimizationSettings + mutable emitTailcalls: bool + mutable deterministic: bool #if PREFERRED_UI_LANG mutable preferredUiLang: string option #endif - mutable lcid : int option - mutable productNameForBannerText : string - mutable showBanner : bool - mutable showTimes : bool - mutable showLoadedAssemblies : bool - mutable continueAfterParseFailure : bool + mutable lcid : int option + mutable productNameForBannerText: string + mutable showBanner : bool + mutable showTimes: bool + mutable showLoadedAssemblies: bool + mutable continueAfterParseFailure: bool #if EXTENSIONTYPING - mutable showExtensionTypeMessages : bool + mutable showExtensionTypeMessages: bool #endif - mutable pause : bool - mutable alwaysCallVirt : bool - mutable noDebugData : bool + mutable pause: bool + mutable alwaysCallVirt: bool + mutable noDebugData: bool /// If true, indicates all type checking and code generation is in the context of fsi.exe - isInteractive : bool - isInvalidationSupported : bool - mutable sqmSessionGuid : System.Guid option - mutable sqmNumOfSourceFiles : int - sqmSessionStartedTime : int64 - mutable emitDebugInfoInQuotations : bool - mutable exename : string option - mutable copyFSharpCore : bool - mutable shadowCopyReferences : bool + isInteractive: bool + isInvalidationSupported: bool + mutable sqmSessionGuid: System.Guid option + mutable sqmNumOfSourceFiles: int + sqmSessionStartedTime: int64 + mutable emitDebugInfoInQuotations: bool + mutable exename: string option + mutable copyFSharpCore: bool + mutable shadowCopyReferences: bool } - static member CreateNew : + static member Initial: TcConfigBuilder + + static member CreateNew: legacyReferenceResolver: ReferenceResolver.Resolver * defaultFSharpBinariesDir: string * optimizeForMemory: bool * @@ -380,16 +377,16 @@ type TcConfigBuilder = isInvalidationSupported: bool * defaultCopyFSharpCore: bool -> TcConfigBuilder - member DecideNames : string list -> outfile: string * pdbfile: string option * assemblyName: string - member TurnWarningOff : range * string -> unit - member TurnWarningOn : range * string -> unit - member AddIncludePath : range * string * string -> unit - member AddReferencedAssemblyByPath : range * string -> unit - member RemoveReferencedAssemblyByPath : range * string -> unit - member AddEmbeddedSourceFile : string -> unit - member AddEmbeddedResource : string -> unit + member DecideNames: string list -> outfile: string * pdbfile: string option * assemblyName: string + member TurnWarningOff: range * string -> unit + member TurnWarningOn: range * string -> unit + member AddIncludePath: range * string * string -> unit + member AddReferencedAssemblyByPath: range * string -> unit + member RemoveReferencedAssemblyByPath: range * string -> unit + member AddEmbeddedSourceFile: string -> unit + member AddEmbeddedResource: string -> unit - static member SplitCommandLineResourceInfo : string -> string * string * ILResourceAccess + static member SplitCommandLineResourceInfo: string -> string * string * ILResourceAccess @@ -413,146 +410,141 @@ type TcConfig = member implicitOpens: string list member useFsiAuxLib: bool member framework: bool - member implicitlyResolveAssemblies : bool + member implicitlyResolveAssemblies: bool /// Set if the user has explicitly turned indentation-aware syntax on/off member light: bool option member conditionalCompilationDefines: string list - member subsystemVersion : int * int - member useHighEntropyVA : bool + member subsystemVersion: int * int + member useHighEntropyVA: bool member referencedDLLs: AssemblyReference list member optimizeForMemory: bool member inputCodePage: int option - member embedResources : string list - member globalWarnAsError: bool - member globalWarnLevel: int - member specificWarnOn: int list - member specificWarnOff: int list - member specificWarnAsError: int list - member specificWarnAsWarn : int list + member embedResources: string list + member errorSeverityOptions: FSharpErrorSeverityOptions member mlCompatibility:bool member checkOverflow:bool member showReferenceResolutions:bool - member outputFile : string option - member platform : ILPlatform option - member prefer32Bit : bool - member useSimpleResolution : bool - member target : CompilerTarget - member debuginfo : bool - member testFlagEmitFeeFeeAs100001 : bool - member dumpDebugInfo : bool - member debugSymbolFile : string option - member typeCheckOnly : bool - member parseOnly : bool - member importAllReferencesOnly : bool - member simulateException : string option - member printAst : bool - member tokenizeOnly : bool - member testInteractionParser : bool - member reportNumDecls : bool - member printSignature : bool - member printSignatureFile : string - member xmlDocOutputFile : string option - member stats : bool - member generateFilterBlocks : bool - member signer : string option - member container : string option - member delaysign : bool - member publicsign : bool - member version : VersionFlag - member metadataVersion : string option - member standalone : bool - member extraStaticLinkRoots : string list - member noSignatureData : bool - member onlyEssentialOptimizationData : bool - member useOptimizationDataFile : bool - member jitTracking : bool - member portablePDB : bool - member embeddedPDB : bool - member embedAllSource : bool - member embedSourceList : string list - member sourceLink : string - member ignoreSymbolStoreSequencePoints : bool - member internConstantStrings : bool - member extraOptimizationIterations : int - member win32res : string - member win32manifest : string - member includewin32manifest : bool - member linkResources : string list - member showFullPaths : bool - member errorStyle : ErrorStyle - member utf8output : bool - member flatErrors : bool - - member maxErrors : int - member baseAddress : int32 option + member outputFile: string option + member platform: ILPlatform option + member prefer32Bit: bool + member useSimpleResolution: bool + member target: CompilerTarget + member debuginfo: bool + member testFlagEmitFeeFeeAs100001: bool + member dumpDebugInfo: bool + member debugSymbolFile: string option + member typeCheckOnly: bool + member parseOnly: bool + member importAllReferencesOnly: bool + member simulateException: string option + member printAst: bool + member tokenizeOnly: bool + member testInteractionParser: bool + member reportNumDecls: bool + member printSignature: bool + member printSignatureFile: string + member xmlDocOutputFile: string option + member stats: bool + member generateFilterBlocks: bool + member signer: string option + member container: string option + member delaysign: bool + member publicsign: bool + member version: VersionFlag + member metadataVersion: string option + member standalone: bool + member extraStaticLinkRoots: string list + member noSignatureData: bool + member onlyEssentialOptimizationData: bool + member useOptimizationDataFile: bool + member jitTracking: bool + member portablePDB: bool + member embeddedPDB: bool + member embedAllSource: bool + member embedSourceList: string list + member sourceLink: string + member ignoreSymbolStoreSequencePoints: bool + member internConstantStrings: bool + member extraOptimizationIterations: int + member win32res: string + member win32manifest: string + member includewin32manifest: bool + member linkResources: string list + member showFullPaths: bool + member errorStyle: ErrorStyle + member utf8output: bool + member flatErrors: bool + + member maxErrors: int + member baseAddress: int32 option #if DEBUG - member showOptimizationData : bool + member showOptimizationData: bool #endif - member showTerms : bool - member writeTermsToFiles : bool - member doDetuple : bool - member doTLR : bool - member doFinalSimplify : bool - member optSettings : Optimizer.OptimizationSettings - member emitTailcalls : bool - member deterministic : bool + member showTerms : bool + member writeTermsToFiles: bool + member doDetuple : bool + member doTLR : bool + member doFinalSimplify: bool + member optSettings : Optimizer.OptimizationSettings + member emitTailcalls: bool + member deterministic: bool #if PREFERRED_UI_LANG member preferredUiLang: string option #else - member lcid : int option + member lcid : int option #endif - member optsOn : bool - member productNameForBannerText : string - member showBanner : bool - member showTimes : bool - member showLoadedAssemblies : bool - member continueAfterParseFailure : bool + member optsOn : bool + member productNameForBannerText: string + member showBanner : bool + member showTimes: bool + member showLoadedAssemblies: bool + member continueAfterParseFailure: bool #if EXTENSIONTYPING - member showExtensionTypeMessages : bool + member showExtensionTypeMessages: bool #endif - member pause : bool - member alwaysCallVirt : bool - member noDebugData : bool + member pause: bool + member alwaysCallVirt: bool + member noDebugData: bool /// If true, indicates all type checking and code generation is in the context of fsi.exe - member isInteractive : bool - member isInvalidationSupported : bool + member isInteractive: bool + member isInvalidationSupported: bool - member ComputeLightSyntaxInitialStatus : string -> bool - member GetTargetFrameworkDirectories : unit -> string list + member ComputeLightSyntaxInitialStatus: string -> bool + member GetTargetFrameworkDirectories: unit -> string list /// Get the loaded sources that exist and issue a warning for the ones that don't - member GetAvailableLoadedSources : unit -> (range*string) list + member GetAvailableLoadedSources: unit -> (range*string) list - member ComputeCanContainEntryPoint : sourceFiles:string list -> bool list *bool + member ComputeCanContainEntryPoint: sourceFiles:string list -> bool list *bool /// File system query based on TcConfig settings - member ResolveSourceFile : range * filename: string * pathLoadedFrom: string -> string + member ResolveSourceFile: range * filename: string * pathLoadedFrom: string -> string /// File system query based on TcConfig settings - member MakePathAbsolute : string -> string + member MakePathAbsolute: string -> string - member sqmSessionGuid : System.Guid option - member sqmNumOfSourceFiles : int - member sqmSessionStartedTime : int64 - member copyFSharpCore : bool - member shadowCopyReferences : bool - static member Create : TcConfigBuilder * validate: bool -> TcConfig + member sqmSessionGuid: System.Guid option + member sqmNumOfSourceFiles: int + member sqmSessionStartedTime: int64 + member copyFSharpCore: bool + member shadowCopyReferences: bool + static member Create: TcConfigBuilder * validate: bool -> TcConfig /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. [] type TcConfigProvider = - member Get : CompilationThreadToken -> TcConfig + member Get: CompilationThreadToken -> TcConfig /// Get a TcConfigProvider which will return only the exact TcConfig. - static member Constant : TcConfig -> TcConfigProvider + static member Constant: TcConfig -> TcConfigProvider /// Get a TcConfigProvider which will continue to respect changes in the underlying /// TcConfigBuilder rather than delivering snapshots. - static member BasedOnMutableBuilder : TcConfigBuilder -> TcConfigProvider + static member BasedOnMutableBuilder: TcConfigBuilder -> TcConfigProvider //---------------------------------------------------------------------------- // Tables of referenced DLLs @@ -566,9 +558,9 @@ type ImportedBinary = #if EXTENSIONTYPING ProviderGeneratedAssembly: System.Reflection.Assembly option IsProviderGenerated: bool - ProviderGeneratedStaticLinkMap : ProvidedAssemblyStaticLinkingMap option + ProviderGeneratedStaticLinkMap: ProvidedAssemblyStaticLinkingMap option #endif - ILAssemblyRefs : ILAssemblyRef list + ILAssemblyRefs: ILAssemblyRef list ILScopeRef: ILScopeRef} /// Represents a resolved imported assembly @@ -582,15 +574,15 @@ type ImportedAssembly = IsProviderGenerated: bool mutable TypeProviders: Tainted list #endif - FSharpOptimizationData : Lazy> } + FSharpOptimizationData: Lazy> } [] type TcAssemblyResolutions = - member GetAssemblyResolutions : unit -> AssemblyResolution list + member GetAssemblyResolutions: unit -> AssemblyResolution list - static member SplitNonFoundationalResolutions : CompilationThreadToken * TcConfig -> AssemblyResolution list * AssemblyResolution list * UnresolvedAssemblyReference list - static member BuildFromPriorResolutions : CompilationThreadToken * TcConfig * AssemblyResolution list * UnresolvedAssemblyReference list -> TcAssemblyResolutions + static member SplitNonFoundationalResolutions : CompilationThreadToken * TcConfig -> AssemblyResolution list * AssemblyResolution list * UnresolvedAssemblyReference list + static member BuildFromPriorResolutions : CompilationThreadToken * TcConfig * AssemblyResolution list * UnresolvedAssemblyReference list -> TcAssemblyResolutions @@ -598,64 +590,64 @@ type TcAssemblyResolutions = [] type TcImports = interface System.IDisposable - //new : TcImports option -> TcImports - member DllTable : NameMap with get - member GetImportedAssemblies : unit -> ImportedAssembly list - member GetCcusInDeclOrder : unit -> CcuThunk list + //new: TcImports option -> TcImports + member DllTable: NameMap with get + member GetImportedAssemblies: unit -> ImportedAssembly list + member GetCcusInDeclOrder: unit -> CcuThunk list /// This excludes any framework imports (which may be shared between multiple builds) - member GetCcusExcludingBase : unit -> CcuThunk list - member FindDllInfo : CompilationThreadToken * range * string -> ImportedBinary - member TryFindDllInfo : CompilationThreadToken * range * string * lookupOnly: bool -> option - member FindCcuFromAssemblyRef : CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult + member GetCcusExcludingBase: unit -> CcuThunk list + member FindDllInfo: CompilationThreadToken * range * string -> ImportedBinary + member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> option + member FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult #if EXTENSIONTYPING - member ProviderGeneratedTypeRoots : ProviderGeneratedType list + member ProviderGeneratedTypeRoots: ProviderGeneratedType list #endif - member GetImportMap : unit -> Import.ImportMap + member GetImportMap: unit -> Import.ImportMap /// Try to resolve a referenced assembly based on TcConfig settings. - member TryResolveAssemblyReference : CompilationThreadToken * AssemblyReference * ResolveAssemblyReferenceMode -> OperationResult + member TryResolveAssemblyReference: CompilationThreadToken * AssemblyReference * ResolveAssemblyReferenceMode -> OperationResult /// Resolve a referenced assembly and report an error if the resolution fails. - member ResolveAssemblyReference : CompilationThreadToken * AssemblyReference * ResolveAssemblyReferenceMode -> AssemblyResolution list + member ResolveAssemblyReference: CompilationThreadToken * AssemblyReference * ResolveAssemblyReferenceMode -> AssemblyResolution list /// Try to find the given assembly reference by simple name. Used in magic assembly resolution. Effectively does implicit /// unification of assemblies by simple assembly name. - member TryFindExistingFullyQualifiedPathBySimpleAssemblyName : CompilationThreadToken * string -> string option + member TryFindExistingFullyQualifiedPathBySimpleAssemblyName: CompilationThreadToken * string -> string option /// Try to find the given assembly reference. - member TryFindExistingFullyQualifiedPathByExactAssemblyRef : CompilationThreadToken * ILAssemblyRef -> string option + member TryFindExistingFullyQualifiedPathByExactAssemblyRef: CompilationThreadToken * ILAssemblyRef -> string option #if EXTENSIONTYPING /// Try to find a provider-generated assembly - member TryFindProviderGeneratedAssemblyByName : CompilationThreadToken * assemblyName:string -> System.Reflection.Assembly option + member TryFindProviderGeneratedAssemblyByName: CompilationThreadToken * assemblyName:string -> System.Reflection.Assembly option #endif /// Report unresolved references that also weren't consumed by any type providers. - member ReportUnresolvedAssemblyReferences : UnresolvedAssemblyReference list -> unit - member SystemRuntimeContainsType : string -> bool + member ReportUnresolvedAssemblyReferences: UnresolvedAssemblyReference list -> unit + member SystemRuntimeContainsType: string -> bool - static member BuildFrameworkTcImports : CompilationThreadToken * TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Cancellable - static member BuildNonFrameworkTcImports : CompilationThreadToken * TcConfigProvider * TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list -> Cancellable - static member BuildTcImports : CompilationThreadToken * TcConfigProvider -> Cancellable + static member BuildFrameworkTcImports : CompilationThreadToken * TcConfigProvider * AssemblyResolution list * AssemblyResolution list -> Cancellable + static member BuildNonFrameworkTcImports : CompilationThreadToken * TcConfigProvider * TcGlobals * TcImports * AssemblyResolution list * UnresolvedAssemblyReference list -> Cancellable + static member BuildTcImports : CompilationThreadToken * TcConfigProvider -> Cancellable //---------------------------------------------------------------------------- // Special resources in DLLs //-------------------------------------------------------------------------- /// Determine if an IL resource attached to an F# assembly is an F# signature data resource -val IsSignatureDataResource : ILResource -> bool +val IsSignatureDataResource: ILResource -> bool /// Determine if an IL resource attached to an F# assembly is an F# optimization data resource -val IsOptimizationDataResource : ILResource -> bool +val IsOptimizationDataResource: ILResource -> bool /// Determine if an IL resource attached to an F# assembly is an F# quotation data resource for reflected definitions -val IsReflectedDefinitionsResource : ILResource -> bool -val GetSignatureDataResourceName : ILResource -> string +val IsReflectedDefinitionsResource: ILResource -> bool +val GetSignatureDataResourceName: ILResource -> string /// Write F# signature data as an IL resource -val WriteSignatureData : TcConfig * TcGlobals * Tastops.Remap * CcuThunk * string -> ILResource +val WriteSignatureData: TcConfig * TcGlobals * Tastops.Remap * CcuThunk * filename: string * inMem: bool -> ILResource /// Write F# optimization data as an IL resource -val WriteOptimizationData : TcGlobals * string * CcuThunk * Optimizer.LazyModuleInfo -> ILResource +val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk * Optimizer.LazyModuleInfo -> ILResource //---------------------------------------------------------------------------- @@ -664,39 +656,39 @@ val WriteOptimizationData : TcGlobals * string * CcuThunk * Optimizer.LazyModul /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -val RequireDLL : CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: string * referenceRange: range * file: string -> TcEnv * (ImportedBinary list * ImportedAssembly list) +val RequireDLL: CompilationThreadToken * TcImports * TcEnv * thisAssemblyName: string * referenceRange: range * file: string -> TcEnv * (ImportedBinary list * ImportedAssembly list) /// Processing # commands -val ProcessMetaCommandsFromInput : +val ProcessMetaCommandsFromInput: (('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> range * string -> unit)) -> TcConfigBuilder * Ast.ParsedInput * string * 'T -> 'T /// Process all the #r, #I etc. in an input -val ApplyMetaCommandsFromInputToTcConfig : TcConfig * Ast.ParsedInput * string -> TcConfig +val ApplyMetaCommandsFromInputToTcConfig: TcConfig * Ast.ParsedInput * string -> TcConfig /// Process the #nowarn in an input -val ApplyNoWarnsToTcConfig : TcConfig * Ast.ParsedInput * string -> TcConfig +val ApplyNoWarnsToTcConfig: TcConfig * Ast.ParsedInput * string -> TcConfig //---------------------------------------------------------------------------- // Scoped pragmas //-------------------------------------------------------------------------- /// Find the scoped #nowarn pragmas with their range information -val GetScopedPragmasForInput : Ast.ParsedInput -> ScopedPragma list +val GetScopedPragmasForInput: Ast.ParsedInput -> ScopedPragma list /// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetErrorLoggerFilteringByScopedPragmas : checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger +val GetErrorLoggerFilteringByScopedPragmas: checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger /// This list is the default set of references for "non-project" files. -val DefaultReferencesForScriptsAndOutOfProjectSources : bool -> string list +val DefaultReferencesForScriptsAndOutOfProjectSources: bool -> string list //---------------------------------------------------------------------------- // Parsing //-------------------------------------------------------------------------- /// Parse one input file -val ParseOneInputFile : TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option +val ParseOneInputFile: TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: (bool * bool) * ErrorLogger * (*retryLocked*) bool -> ParsedInput option //---------------------------------------------------------------------------- // Type checking and querying the type checking state @@ -704,30 +696,30 @@ val ParseOneInputFile : TcConfig * Lexhelp.LexResourceManager * string list * st /// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. -val GetInitialTcEnv : assemblyName: string * range * TcConfig * TcImports * TcGlobals -> TcEnv +val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlobals -> TcEnv [] /// Represents the incremental type checking state for a set of inputs type TcState = - member NiceNameGenerator : Ast.NiceNameGenerator + member NiceNameGenerator: Ast.NiceNameGenerator /// The CcuThunk for the current assembly being checked - member Ccu : CcuThunk + member Ccu: CcuThunk /// Get the typing environment implied by the set of signature files and/or inferred signatures of implementation files checked so far - member TcEnvFromSignatures : TcEnv + member TcEnvFromSignatures: TcEnv /// Get the typing environment implied by the set of implementation files checked so far - member TcEnvFromImpls : TcEnv + member TcEnvFromImpls: TcEnv /// The inferred contents of the assembly, containing the signatures of all implemented files. - member PartialAssemblySignature : ModuleOrNamespaceType + member PartialAssemblySignature: ModuleOrNamespaceType - member NextStateAfterIncrementalFragment : TcEnv -> TcState + member NextStateAfterIncrementalFragment: TcEnv -> TcState - member CreatesGeneratedProvidedTypes : bool + member CreatesGeneratedProvidedTypes: bool /// Get the initial type checking state for a set of inputs -val GetInitialTcState : +val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * Ast.NiceNameGenerator * TcEnv -> TcState /// Check one input, returned as an Eventually computation @@ -736,13 +728,13 @@ val TypeCheckOneInputEventually : -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState> /// Finish the checking of multiple inputs -val TypeCheckMultipleInputsFinish : (TcEnv * TopAttribs * 'T list) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState +val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T list) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState /// Finish the checking of a closed set of inputs -val TypeCheckClosedInputSetFinish : TypedImplFile list * TcState -> TcState * TypedImplFile list +val TypeCheckClosedInputSetFinish: TypedImplFile list * TcState -> TcState * TypedImplFile list /// Check a closed set of inputs -val TypeCheckClosedInputSet : CompilationThreadToken * checkForErrors: (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput list -> TcState * TopAttribs * TypedImplFile list * TcEnv +val TypeCheckClosedInputSet: CompilationThreadToken * checkForErrors: (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput list -> TcState * TopAttribs * TypedImplFile list * TcEnv /// Check a single input and finish the checking val TypeCheckOneInputAndFinishEventually : @@ -750,10 +742,10 @@ val TypeCheckOneInputAndFinishEventually : -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState> /// Indicates if we should report a warning -val ReportWarning : globalWarnLevel: int * specificWarnOff: int list * specificWarnOn: int list -> PhasedDiagnostic -> bool +val ReportWarning: FSharpErrorSeverityOptions -> PhasedDiagnostic -> bool /// Indicates if we should report a warning as an error -val ReportWarningAsError : globalWarnLevel: int * specificWarnOff: int list * specificWarnOn: int list * specificWarnAsError: int list * specificWarnAsWarn: int list * globalWarnAsError: bool -> PhasedDiagnostic -> bool +val ReportWarningAsError: FSharpErrorSeverityOptions -> PhasedDiagnostic -> bool //---------------------------------------------------------------------------- // #load closure @@ -782,7 +774,7 @@ type LoadClosure = References: (string * AssemblyResolution list) list /// The list of references that were not resolved during load closure. - UnresolvedReferences : UnresolvedAssemblyReference list + UnresolvedReferences: UnresolvedAssemblyReference list /// The list of all sources in the closure with inputs when available, with associated parse errors and warnings Inputs: LoadClosureInput list @@ -794,16 +786,16 @@ type LoadClosure = NoWarns: (string * range list) list /// Diagnostics seen while processing resolutions - ResolutionDiagnostics : (PhasedDiagnostic * bool) list + ResolutionDiagnostics: (PhasedDiagnostic * bool) list /// Diagnostics to show for root of closure (used by fsc.fs) - AllRootFileDiagnostics : (PhasedDiagnostic * bool) list + AllRootFileDiagnostics: (PhasedDiagnostic * bool) list /// Diagnostics seen while processing the compiler options implied root of closure - LoadClosureRootFileDiagnostics : (PhasedDiagnostic * bool) list } + LoadClosureRootFileDiagnostics: (PhasedDiagnostic * bool) list } // Used from service.fs, when editing a script file - static member ComputeClosureOfSourceText : CompilationThreadToken * legacyReferenceResolver: ReferenceResolver.Resolver * defaultFSharpBinariesDir: string * filename: string * source: string * implicitDefines:CodeContext * useSimpleResolution: bool * useFsiAuxLib: bool * lexResourceManager: Lexhelp.LexResourceManager * applyCompilerOptions: (TcConfigBuilder -> unit) * assumeDotNetFramework : bool -> LoadClosure + static member ComputeClosureOfSourceText: CompilationThreadToken * legacyReferenceResolver: ReferenceResolver.Resolver * defaultFSharpBinariesDir: string * filename: string * source: string * implicitDefines:CodeContext * useSimpleResolution: bool * useFsiAuxLib: bool * lexResourceManager: Lexhelp.LexResourceManager * applyCompilerOptions: (TcConfigBuilder -> unit) * assumeDotNetFramework: bool -> LoadClosure /// Used from fsi.fs and fsc.fs, for #load and command line. The resulting references are then added to a TcConfig. - static member ComputeClosureOfSourceFiles : CompilationThreadToken * tcConfig:TcConfig * (string * range) list * implicitDefines:CodeContext * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure + static member ComputeClosureOfSourceFiles: CompilationThreadToken * tcConfig:TcConfig * (string * range) list * implicitDefines:CodeContext * lexResourceManager: Lexhelp.LexResourceManager -> LoadClosure diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 892914d039..ce26cafde0 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -380,9 +380,7 @@ let ParseCompilerOptions (collectOtherArgument : string -> unit, blocks: Compile let rest = attempt specs processArg rest - let result = processArg args - result - + processArg args //---------------------------------------------------------------------------- // Compiler options @@ -550,34 +548,49 @@ let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB // OptionBlock: Errors and warnings //--------------------------------- -let errorsAndWarningsFlags (tcConfigB : TcConfigBuilder) = +let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = + let trimFS (s:string) = if s.StartsWith("FS", StringComparison.Ordinal) = true then s.Substring(2) else s + let trimFStoInt (s:string) = + try + Some (int32 (trimFS s)) + with _ -> + errorR(Error(FSComp.SR.buildArgInvalidInt(s),rangeCmdArgs)) + None [ - CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> tcConfigB.globalWarnAsError <- switch <> OptionSwitch.Off), None, - Some (FSComp.SR.optsWarnaserrorPM())); - - CompilerOption("warnaserror", tagWarnList, OptionIntListSwitch (fun n switch -> - if switch = OptionSwitch.Off then - tcConfigB.specificWarnAsError <- ListSet.remove (=) n tcConfigB.specificWarnAsError ; - tcConfigB.specificWarnAsWarn <- ListSet.insert (=) n tcConfigB.specificWarnAsWarn - else - tcConfigB.specificWarnAsWarn <- ListSet.remove (=) n tcConfigB.specificWarnAsWarn ; - tcConfigB.specificWarnAsError <- ListSet.insert (=) n tcConfigB.specificWarnAsError), None, - Some (FSComp.SR.optsWarnaserror())); - - CompilerOption("warn", tagInt, OptionInt (fun n -> - tcConfigB.globalWarnLevel <- - if (n >= 0 && n <= 5) then n - else error(Error(FSComp.SR.optsInvalidWarningLevel(n),rangeCmdArgs))), None, - Some (FSComp.SR.optsWarn())); - - CompilerOption("nowarn", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOff(rangeCmdArgs, n)), None, - Some (FSComp.SR.optsNowarn())); - - CompilerOption("warnon", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOn(rangeCmdArgs,n)), None, - Some(FSComp.SR.optsWarnOn())); + CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with + GlobalWarnAsError = switch <> OptionSwitch.Off }), None, Some (FSComp.SR.optsWarnaserrorPM())) + + CompilerOption("warnaserror", tagWarnList, OptionStringListSwitch (fun n switch -> + match trimFStoInt n with + | Some n -> + let options = tcConfigB.errorSeverityOptions + tcConfigB.errorSeverityOptions <- + if switch = OptionSwitch.Off then + { options with + WarnAsError = ListSet.remove (=) n options.WarnAsError + WarnAsWarn = ListSet.insert (=) n options.WarnAsWarn } + else + { options with + WarnAsError = ListSet.insert (=) n options.WarnAsError + WarnAsWarn = ListSet.remove (=) n options.WarnAsWarn } + | None -> ()), None, Some (FSComp.SR.optsWarnaserror())) + + CompilerOption("warn", tagInt, OptionInt (fun n -> + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with + WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel(n), rangeCmdArgs)) } + ), None, Some (FSComp.SR.optsWarn())) + + CompilerOption("nowarn", tagWarnList, OptionStringList (fun n -> + tcConfigB.TurnWarningOff(rangeCmdArgs, trimFS n)), None, Some (FSComp.SR.optsNowarn())) + + CompilerOption("warnon", tagWarnList, OptionStringList (fun n -> + tcConfigB.TurnWarningOn(rangeCmdArgs, trimFS n)), None, Some (FSComp.SR.optsWarnOn())) - CompilerOption("consolecolors", tagNone, OptionSwitch (fun switch -> enableConsoleColoring <- switch = OptionSwitch.On), None, - Some (FSComp.SR.optsConsoleColors())) + CompilerOption("consolecolors", tagNone, OptionSwitch (fun switch -> + enableConsoleColoring <- switch = OptionSwitch.On), None, Some (FSComp.SR.optsConsoleColors())) ] @@ -1119,7 +1132,15 @@ let GetCoreFsiCompilerOptions (tcConfigB: TcConfigBuilder) = testingAndQAFlags tcConfigB]) ] - +let ApplyCommandLineArgs(tcConfigB: TcConfigBuilder, sourceFiles: string list, commandLineArgs) = + try + let sourceFilesAcc = ResizeArray(sourceFiles) + let collect name = if not (Filename.isDll name) then sourceFilesAcc.Add(name) + ParseCompilerOptions(collect, GetCoreServiceCompilerOptions tcConfigB, commandLineArgs) + ResizeArray.toList(sourceFilesAcc) + with e -> + errorRecovery e range0 + sourceFiles //---------------------------------------------------------------------------- diff --git a/src/fsharp/CompileOptions.fsi b/src/fsharp/CompileOptions.fsi index 2626f1ebe2..2a6858b1ff 100644 --- a/src/fsharp/CompileOptions.fsi +++ b/src/fsharp/CompileOptions.fsi @@ -69,6 +69,9 @@ val GetCoreFscCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list val GetCoreFsiCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list val GetCoreServiceCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +/// Apply args to TcConfigBuilder and return new list of source files +val ApplyCommandLineArgs: tcConfigB: TcConfigBuilder * sourceFiles: string list * argv: string list -> string list + // Expose the "setters" for some user switches, to enable setting of defaults val SetOptimizeSwitch : TcConfigBuilder -> OptionSwitch -> unit val SetTailcallSwitch : TcConfigBuilder -> OptionSwitch -> unit diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 5567225e4e..d854d89757 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -6,7 +6,6 @@ module public Microsoft.FSharp.Compiler.ErrorLogger module internal Microsoft.FSharp.Compiler.ErrorLogger #endif - open Internal.Utilities open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics @@ -52,7 +51,7 @@ exception ReportedError of exn option with let rec findOriginalException err = match err with | ReportedError (Some err) -> err - | WrappedError(err,_) -> findOriginalException err + | WrappedError(err, _) -> findOriginalException err | _ -> err type Suggestions = unit -> Set @@ -75,20 +74,20 @@ let StopProcessing<'T> = StopProcessingExn None exception NumberedError of (int * string) * range with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | NumberedError((_,msg),_) -> msg + | NumberedError((_, msg), _) -> msg | _ -> "impossible" exception Error of (int * string) * range with // int is e.g. 191 in FS0191 // eventually remove this type, it is a transitional artifact of the old unnumbered error style override this.Message = match this :> exn with - | Error((_,msg),_) -> msg + | Error((_, msg), _) -> msg | _ -> "impossible" exception InternalError of msg: string * range with override this.Message = match this :> exn with - | InternalError(msg,m) -> msg + m.ToString() + | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" exception UserCompilerMessage of string * int * range @@ -107,7 +106,7 @@ exception UnresolvedPathReference of (*assemblyname*) string * (*path*) string * exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | ErrorWithSuggestions((_,msg),_,_,_) -> msg + | ErrorWithSuggestions((_, msg), _, _, _) -> msg | _ -> "impossible" @@ -122,7 +121,7 @@ let inline protectAssemblyExplorationF dflt f = try f() with - | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName,path) + | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName, path) | _ -> reraise() let inline protectAssemblyExplorationNoReraise dflt1 dflt2 f = @@ -139,10 +138,10 @@ let rec AttachRange m (exn:exn) = match exn with // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException - | UnresolvedReferenceNoRange(a) -> UnresolvedReferenceError(a,m) - | UnresolvedPathReferenceNoRange(a,p) -> UnresolvedPathReference(a,p,m) - | Failure(msg) -> InternalError(msg^" (Failure)",m) - | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)",m) + | UnresolvedReferenceNoRange(a) -> UnresolvedReferenceError(a, m) + | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) + | Failure(msg) -> InternalError(msg^" (Failure)", m) + | :? System.ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) | notARangeDual -> notARangeDual @@ -203,7 +202,7 @@ type PhasedDiagnostic = { Exception:exn; Phase:BuildPhase } /// Construct a phased error - static member Create(exn:exn,phase:BuildPhase) : PhasedDiagnostic = + static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = // FUTURE: renable this assert, which has historically triggered in some compiler service scenarios // System.Diagnostics.Debug.Assert(phase<>BuildPhase.DefaultPhase, sprintf "Compile error seen with no phase to attribute it to.%A %s %s" phase exn.Message exn.StackTrace ) {Exception = exn; Phase=phase} @@ -283,13 +282,13 @@ type ErrorLogger(nameForDebugging:string) = let DiscardErrorsLogger = { new ErrorLogger("DiscardErrorsLogger") with - member x.DiagnosticSink(phasedError,isError) = () + member x.DiagnosticSink(phasedError, isError) = () member x.ErrorCount = 0 } let AssertFalseErrorLogger = { new ErrorLogger("AssertFalseErrorLogger") with // TODO: renable these asserts in the compiler service - member x.DiagnosticSink(phasedError,isError) = (* assert false; *) () + member x.DiagnosticSink(phasedError, isError) = (* assert false; *) () member x.ErrorCount = (* assert false; *) 0 } @@ -371,8 +370,8 @@ module ErrorLoggerExtensions = member x.ErrorR exn = match exn with - | InternalError (s,_) - | Failure s as exn -> System.Diagnostics.Debug.Assert(false,sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) + | InternalError (s, _) + | Failure s as exn -> System.Diagnostics.Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) | _ -> () match exn with @@ -380,7 +379,7 @@ module ErrorLoggerExtensions = | ReportedError _ -> PreserveStackTrace(exn) raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn,CompileThreadStatic.BuildPhase), true) + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), true) member x.Warning exn = match exn with @@ -388,7 +387,7 @@ module ErrorLoggerExtensions = | ReportedError _ -> PreserveStackTrace(exn) raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn,CompileThreadStatic.BuildPhase), false) + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), false) member x.Error exn = x.ErrorR exn @@ -405,10 +404,10 @@ module ErrorLoggerExtensions = (* Don't send ThreadAbortException down the error channel *) #if FX_REDUCED_EXCEPTIONS #else - | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException),_) -> () + | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException), _) -> () #endif - | ReportedError _ | WrappedError(ReportedError _,_) -> () - | StopProcessing | WrappedError(StopProcessing,_) -> + | ReportedError _ | WrappedError(ReportedError _, _) -> () + | StopProcessing | WrappedError(StopProcessing, _) -> PreserveStackTrace(exn) raise exn | _ -> @@ -416,7 +415,7 @@ module ErrorLoggerExtensions = x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. ReraiseIfWatsonable(exn) with - | ReportedError _ | WrappedError(ReportedError _,_) -> () + | ReportedError _ | WrappedError(ReportedError _, _) -> () member x.StopProcessingRecovery (exn:exn) (m:range) = // Do standard error recovery. @@ -424,12 +423,12 @@ module ErrorLoggerExtensions = // Additionally ignore/catch ReportedError. // Can throw other exceptions raised by the DiagnosticSink(exn) handler. match exn with - | StopProcessing | WrappedError(StopProcessing,_) -> () // suppress, so skip error recovery. + | StopProcessing | WrappedError(StopProcessing, _) -> () // suppress, so skip error recovery. | _ -> try x.ErrorRecovery exn m with - | StopProcessing | WrappedError(StopProcessing,_) -> () // catch, e.g. raised by DiagnosticSink. - | ReportedError _ | WrappedError(ReportedError _,_) -> () // catch, but not expected unless ErrorRecovery is changed. + | StopProcessing | WrappedError(StopProcessing, _) -> () // catch, e.g. raised by DiagnosticSink. + | ReportedError _ | WrappedError(ReportedError _, _) -> () // catch, but not expected unless ErrorRecovery is changed. member x.ErrorRecoveryNoRange (exn:exn) = x.ErrorRecovery exn range0 @@ -488,7 +487,7 @@ let errorRecoveryNoRange exn = CompileThreadStatic.ErrorLogger.ErrorRecoveryNoRa let report f = f() -let deprecatedWithError s m = errorR(Deprecated(s,m)) +let deprecatedWithError s m = errorR(Deprecated(s, m)) // Note: global state, but only for compiling FSharp.Core.dll let mutable reportLibraryOnlyFeatures = true @@ -502,7 +501,7 @@ let suppressErrorReporting f = try let errorLogger = { new ErrorLogger("suppressErrorReporting") with - member x.DiagnosticSink(_phasedError,_isError) = () + member x.DiagnosticSink(_phasedError, _isError) = () member x.ErrorCount = 0 } SetThreadErrorLoggerNoUnwind(errorLogger) f() @@ -530,30 +529,30 @@ let ReportWarnings warns = let CommitOperationResult res = match res with - | OkResult (warns,res) -> ReportWarnings warns; res - | ErrorResult (warns,err) -> ReportWarnings warns; error err + | OkResult (warns, res) -> ReportWarnings warns; res + | ErrorResult (warns, err) -> ReportWarnings warns; error err let RaiseOperationResult res : unit = CommitOperationResult res -let ErrorD err = ErrorResult([],err) -let WarnD err = OkResult([err],()) -let CompleteD = OkResult([],()) -let ResultD x = OkResult([],x) +let ErrorD err = ErrorResult([], err) +let WarnD err = OkResult([err], ()) +let CompleteD = OkResult([], ()) +let ResultD x = OkResult([], x) let CheckNoErrorsAndGetWarnings res = match res with - | OkResult (warns,_) -> Some warns + | OkResult (warns, _) -> Some warns | ErrorResult _ -> None /// The bind in the monad. Stop on first error. Accumulate warnings and continue. let (++) res f = match res with - | OkResult([],res) -> (* tailcall *) f res - | OkResult(warns,res) -> + | OkResult([], res) -> (* tailcall *) f res + | OkResult(warns, res) -> match f res with - | OkResult(warns2,res2) -> OkResult(warns@warns2, res2) - | ErrorResult(warns2,err) -> ErrorResult(warns@warns2, err) - | ErrorResult(warns,err) -> - ErrorResult(warns,err) + | OkResult(warns2, res2) -> OkResult(warns@warns2, res2) + | ErrorResult(warns2, err) -> ErrorResult(warns@warns2, err) + | ErrorResult(warns, err) -> + ErrorResult(warns, err) /// Stop on first error. Accumulate warnings and continue. let rec IterateD f xs = @@ -572,11 +571,11 @@ let MapD f xs = loop [] xs type TrackErrorsBuilder() = - member x.Bind(res,k) = res ++ k + member x.Bind(res, k) = res ++ k member x.Return res = ResultD res member x.ReturnFrom res = res - member x.For(seq,k) = IterateD k seq - member x.While(gd,k) = WhileD gd k + member x.For(seq, k) = IterateD k seq + member x.While(gd, k) = WhileD gd k member x.Zero() = CompleteD let trackErrors = TrackErrorsBuilder() @@ -594,14 +593,14 @@ let IterateIdxD f xs = /// Stop on first error. Accumulate warnings and continue. let rec Iterate2D f xs ys = - match xs,ys with - | [],[] -> CompleteD + match xs, ys with + | [], [] -> CompleteD | h1 :: t1, h2::t2 -> f h1 h2 ++ (fun () -> Iterate2D f t1 t2) | _ -> failwith "Iterate2D" let TryD f g = match f() with - | ErrorResult(warns,err) -> (OkResult(warns,())) ++ (fun () -> g err) + | ErrorResult(warns, err) -> (OkResult(warns, ())) ++ (fun () -> g err) | res -> res let rec RepeatWhileD ndeep body = body ndeep ++ (fun x -> if x then RepeatWhileD (ndeep+1) body else CompleteD) @@ -639,4 +638,27 @@ let NormalizeErrorString (text : string) = buf.Append(c) |> ignore 1 i <- i + delta - buf.ToString() \ No newline at end of file + buf.ToString() + +#if COMPILER_PUBLIC_API +type FSharpErrorSeverityOptions = +#else +type internal FSharpErrorSeverityOptions = +#endif + { + WarnLevel: int + GlobalWarnAsError: bool + WarnOff: int list + WarnOn: int list + WarnAsError: int list + WarnAsWarn: int list + } + static member Default = + { + WarnLevel = 3 + GlobalWarnAsError = false + WarnOff = [] + WarnOn = [] + WarnAsError = [] + WarnAsWarn = [] + } diff --git a/src/fsharp/ErrorResolutionHints.fs b/src/fsharp/ErrorResolutionHints.fs index d7fab22057..4b3e47617c 100644 --- a/src/fsharp/ErrorResolutionHints.fs +++ b/src/fsharp/ErrorResolutionHints.fs @@ -13,7 +13,7 @@ let minStringLengthForThreshold = 3 /// We report a candidate if its edit distance is <= the threshold. /// The threshold is set to about a quarter of the number of characters. let IsInEditDistanceProximity idText suggestion = - let editDistance = EditDistance.CalcEditDistance(idText,suggestion) + let editDistance = EditDistance.CalcEditDistance(idText, suggestion) let threshold = match idText.Length with | x when x < 5 -> 1 @@ -48,16 +48,16 @@ let FilterPredictions (idText:string) (suggestionF:ErrorLogger.Suggestions) = let suggestedText = suggestion.ToUpperInvariant() let similarity = EditDistance.JaroWinklerDistance uppercaseText suggestedText if similarity >= highConfidenceThreshold || suggestion.EndsWith ("." + idText) then - Some(similarity,suggestion) + Some(similarity, suggestion) elif similarity < minThresholdForSuggestions && suggestedText.Length > minStringLengthForThreshold then None elif IsInEditDistanceProximity uppercaseText suggestedText then - Some(similarity,suggestion) + Some(similarity, suggestion) else None) |> Seq.sortByDescending fst - |> Seq.mapi (fun i x -> i,x) - |> Seq.takeWhile (fun (i,_) -> i < maxSuggestions) + |> Seq.mapi (fun i x -> i, x) + |> Seq.takeWhile (fun (i, _) -> i < maxSuggestions) |> Seq.map snd |> Seq.toList diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index c99328e853..6e5dc678d2 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1421,3 +1421,4 @@ notAFunctionButMaybeIndexer,"This expression is not a function and cannot be app 3217,notAFunctionButMaybeIndexerErrorCode,"" notAFunctionButMaybeDeclaration,"This value is not a function and cannot be applied. Did you forget to terminate a declaration?" 3218,ArgumentsInSigAndImplMismatch,"The argument names in the signature '%s' and implementation '%s' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling." +3219,pickleUnexpectedNonZero,"An error occurred while reading the F# metadata of assembly '%s'. A reserved construct was utilized. You may need to upgrade your F# compiler or use an earlier version of the assembly that doesn't make use of a specific construct." diff --git a/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj b/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj index be84e9738e..c5c361ca1d 100644 --- a/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj +++ b/src/fsharp/FSharp.Build-proto/FSharp.Build-proto.fsproj @@ -37,6 +37,9 @@ FSharpEmbedResourceText.fs + + FSharpEmbedResXSource.fs + Microsoft.FSharp-proto.targets Microsoft.FSharp-proto.targets @@ -67,6 +70,7 @@ + diff --git a/src/fsharp/FSharp.Build/FSharp.Build.fsproj b/src/fsharp/FSharp.Build/FSharp.Build.fsproj index 8117fccc92..30aeb96da5 100644 --- a/src/fsharp/FSharp.Build/FSharp.Build.fsproj +++ b/src/fsharp/FSharp.Build/FSharp.Build.fsproj @@ -31,6 +31,7 @@ + @@ -59,6 +60,7 @@ + diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs new file mode 100644 index 0000000000..1954d8f56c --- /dev/null +++ b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs @@ -0,0 +1,144 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Build + +open System +open System.Collections +open System.Globalization +open System.IO +open System.Linq +open System.Text +open System.Xml.Linq +open Microsoft.Build.Framework +open Microsoft.Build.Utilities + +type FSharpEmbedResXSource() = + let mutable _buildEngine : IBuildEngine = null + let mutable _hostObject : ITaskHost = null + let mutable _embeddedText : ITaskItem[] = [||] + let mutable _generatedSource : ITaskItem[] = [||] + let mutable _outputPath : string = "" + let mutable _targetFramework : string = "" + + let boilerplate = @"// + +namespace {0} + +open System.Reflection + +module internal {1} = + type private C (_dummy:System.Object) = class end + let mutable Culture = System.Globalization.CultureInfo.CurrentUICulture + let ResourceManager = new System.Resources.ResourceManager(""{2}"", C(null).GetType().GetTypeInfo().Assembly) + let GetString(name:System.String) : System.String = ResourceManager.GetString(name, Culture)" + + let boilerplateGetObject = " let GetObject(name:System.String) : System.Object = ResourceManager.GetObject(name, Culture)" + + let generateSource (resx:string) (fullModuleName:string) (generateLegacy:bool) (generateLiteral:bool) = + try + let printMessage = printfn "FSharpEmbedResXSource: %s" + let justFileName = Path.GetFileNameWithoutExtension(resx) + let sourcePath = Path.Combine(_outputPath, justFileName + ".fs") + + // simple up-to-date check + if File.Exists(resx) && File.Exists(sourcePath) && + File.GetLastWriteTime(resx) <= File.GetLastWriteTime(sourcePath) then + printMessage (sprintf "Skipping generation: '%s' since it is up-to-date." sourcePath) + Some(sourcePath) + else + let namespaceName, moduleName = + let parts = fullModuleName.Split('.') + if parts.Length = 1 then ("global", parts.[0]) + else (String.Join(".", parts, 0, parts.Length - 1), parts.[parts.Length - 1]) + let generateGetObject = not (_targetFramework.StartsWith("netstandard1.") || _targetFramework.StartsWith("netcoreapp1.")) + printMessage (sprintf "Generating code for target framework %s" _targetFramework) + let sb = StringBuilder().AppendLine(String.Format(boilerplate, namespaceName, moduleName, justFileName)) + if generateGetObject then sb.AppendLine(boilerplateGetObject) |> ignore + printMessage <| sprintf "Generating: %s" sourcePath + let body = + let xname = XName.op_Implicit + XDocument.Load(resx).Descendants(xname "data") + |> Seq.fold (fun (sb:StringBuilder) (node:XElement) -> + let name = + match node.Attribute(xname "name") with + | null -> failwith (sprintf "Missing resource name on element '%s'" (node.ToString())) + | attr -> attr.Value + let docComment = + match node.Elements(xname "value").FirstOrDefault() with + | null -> failwith <| sprintf "Missing resource value for '%s'" name + | element -> element.Value.Trim() + let identifier = if Char.IsLetter(name.[0]) || name.[0] = '_' then name else "_" + name + let commentBody = + XElement(xname "summary", docComment).ToString().Split([|"\r\n"; "\r"; "\n"|], StringSplitOptions.None) + |> Array.fold (fun (sb:StringBuilder) line -> sb.AppendLine(" /// " + line)) (StringBuilder()) + // add the resource + let accessorBody = + match (generateLegacy, generateLiteral) with + | (true, true) -> sprintf " []\n let %s = \"%s\"" identifier name + | (true, false) -> sprintf " let %s = \"%s\"" identifier name // the [] attribute can't be used for FSharp.Core + | (false, _) -> + let isStringResource = node.Attribute(xname "type") |> isNull + match (isStringResource, generateGetObject) with + | (true, _) -> sprintf " let %s() = GetString(\"%s\")" identifier name + | (false, true) -> sprintf " let %s() = GetObject(\"%s\")" identifier name + | (false, false) -> "" // the target runtime doesn't support non-string resources + // TODO: When calling the `GetObject` version, parse the `type` attribute to discover the proper return type + sb.AppendLine().Append(commentBody).AppendLine(accessorBody) + ) sb + File.WriteAllText(sourcePath, body.ToString()) + printMessage <| sprintf "Done: %s" sourcePath + Some(sourcePath) + with e -> + printf "An exception occurred when processing '%s'\n%s" resx (e.ToString()) + None + + [] + member this.EmbeddedResource + with get() = _embeddedText + and set(value) = _embeddedText <- value + + [] + member this.IntermediateOutputPath + with get() = _outputPath + and set(value) = _outputPath <- value + + member this.TargetFramework + with get() = _targetFramework + and set(value) = _targetFramework <- value + + [] + member this.GeneratedSource + with get() = _generatedSource + + interface ITask with + member this.BuildEngine + with get() = _buildEngine + and set(value) = _buildEngine <- value + member this.HostObject + with get() = _hostObject + and set(value) = _hostObject <- value + member this.Execute() = + let getBooleanMetadata (metadataName:string) (defaultValue:bool) (item:ITaskItem) = + match item.GetMetadata(metadataName) with + | value when String.IsNullOrWhiteSpace(value) -> defaultValue + | value -> + match value.ToLowerInvariant() with + | "true" -> true + | "false" -> false + | _ -> failwith (sprintf "Expected boolean value for '%s' found '%s'" metadataName value) + let mutable success = true + let generatedSource = + [| for item in this.EmbeddedResource do + if getBooleanMetadata "GenerateSource" false item then + let moduleName = + match item.GetMetadata("GeneratedModuleName") with + | null | "" -> Path.GetFileNameWithoutExtension(item.ItemSpec) + | value -> value + let generateLegacy = getBooleanMetadata "GenerateLegacyCode" false item + let generateLiteral = getBooleanMetadata "GenerateLiterals" true item + match generateSource item.ItemSpec moduleName generateLegacy generateLiteral with + | Some (source) -> yield TaskItem(source) :> ITaskItem + | None -> success <- false + |] + _generatedSource <- generatedSource + success diff --git a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets index 1776fadd3d..fb0957e115 100644 --- a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets +++ b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets @@ -23,6 +23,7 @@ this file. + @@ -175,15 +176,26 @@ this file. + + + + + + + + + + + - + - + - + diff --git a/src/fsharp/FSharp.Compiler.Private/.gitignore b/src/fsharp/FSharp.Compiler.Private/.gitignore new file mode 100644 index 0000000000..fa6bb93f54 --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Private/.gitignore @@ -0,0 +1,9 @@ +illex.fs +ilpars.fs +ilpars.fsi +lex.fs +pars.fs +pars.fsi +pplex.fs +pppars.fs +pppars.fsi diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 10e0f26c59..acfb28e533 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -663,7 +663,7 @@ ..\..\..\packages\System.Reflection.Metadata.1.4.2\lib\portable-net45+win8\System.Reflection.Metadata.dll - ..\..\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + ..\..\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll ..\..\..\packages\System.ValueTuple.4.3.1\lib\netstandard1.0\System.ValueTuple.dll diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec index 8dfb2b6c25..302e10bbe2 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec @@ -16,7 +16,7 @@ - + diff --git a/src/fsharp/FSharp.Compiler.Private/project.json b/src/fsharp/FSharp.Compiler.Private/project.json index c50e8438f9..bee86e2f41 100644 --- a/src/fsharp/FSharp.Compiler.Private/project.json +++ b/src/fsharp/FSharp.Compiler.Private/project.json @@ -1,7 +1,7 @@ { "dependencies": { "NETStandard.Library": "1.6.1", - "System.Collections.Immutable":"1.2.0", + "System.Collections.Immutable":"1.3.1", "System.Diagnostics.Process": "4.3.0", "System.Diagnostics.TraceSource": "4.3.0", "System.Linq.Expressions": "4.3.0", diff --git a/src/fsharp/FSharp.Compiler.Unittests/EditDistance.fs b/src/fsharp/FSharp.Compiler.Unittests/EditDistance.fs index 68b0c0595b..5e8d7f7275 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/EditDistance.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/EditDistance.fs @@ -2,6 +2,7 @@ namespace FSharp.Compiler.Unittests open System +open System.Globalization open System.Text open NUnit.Framework open Microsoft.FSharp.Compiler @@ -16,7 +17,7 @@ module EditDistance = [] [] let JaroWinklerTest (str1 : string, str2 : string) : string = - String.Format("{0:0.000}", JaroWinklerDistance str1 str2) + String.Format(CultureInfo.InvariantCulture, "{0:0.000}", JaroWinklerDistance str1 str2) [] [] diff --git a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec index f75b32320c..bf3b7397d7 100644 --- a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec +++ b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec @@ -17,7 +17,7 @@ - + diff --git a/src/fsharp/FSharp.Compiler.nuget/Testing.FSharp.Compiler.nuspec b/src/fsharp/FSharp.Compiler.nuget/Testing.FSharp.Compiler.nuspec index ff32c71716..ac1069ee47 100644 --- a/src/fsharp/FSharp.Compiler.nuget/Testing.FSharp.Compiler.nuspec +++ b/src/fsharp/FSharp.Compiler.nuget/Testing.FSharp.Compiler.nuspec @@ -16,7 +16,7 @@ - + diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 7310ef8847..c1cfe673bf 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -177,7 +177,6 @@ type AsyncType() = match a.InnerException with | :? TaskCanceledException as t -> () | _ -> reraise() - System.Diagnostics.Debugger.Break() |> ignore Assert.IsTrue (t.IsCompleted, "Task is not completed") [] @@ -408,4 +407,4 @@ type AsyncType() = cts.Cancel() ewh.WaitOne(10000) |> ignore -#endif \ No newline at end of file +#endif diff --git a/src/fsharp/FSharp.Core/FSCore.resx b/src/fsharp/FSharp.Core/FSCore.resx index 9df009a38b..8b74b1d039 100644 --- a/src/fsharp/FSharp.Core/FSCore.resx +++ b/src/fsharp/FSharp.Core/FSCore.resx @@ -501,7 +501,7 @@ type argument out of range - + This value cannot be mutated diff --git a/src/fsharp/FSharp.Core/FSharp.Core.fsproj b/src/fsharp/FSharp.Core/FSharp.Core.fsproj index 204f628733..1270c5cef9 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.fsproj +++ b/src/fsharp/FSharp.Core/FSharp.Core.fsproj @@ -51,15 +51,19 @@ + true + true + false + Microsoft.FSharp.Core.SR FSCore.resx - + Primitives/prim-types-prelude.fsi - - + + Primitives/prim-types-prelude.fs - - + + Primitives/SR.fs diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 87735bfeea..fbab2547ed 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -1418,41 +1418,41 @@ module Query = TransInnerResult.Source(expr), NoConv | Call (_, meth, _) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryCall,meth.ToString()))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryCall),meth.ToString()))) | PropertyGet (_, pinfo, _) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryProperty,pinfo.ToString()))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryProperty),pinfo.ToString()))) | NewObject(ty,_) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstructKind,"new " + ty.ToString()))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstructKind),"new " + ty.ToString()))) | NewArray(ty,_) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstructKind,"NewArray(" + ty.Name + ",...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstructKind),"NewArray(" + ty.Name + ",...)"))) | NewTuple _ when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstructKind,"NewTuple(...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstructKind),"NewTuple(...)"))) | FieldGet (_,field) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstructKind,"FieldGet(" + field.Name + ",...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstructKind),"FieldGet(" + field.Name + ",...)"))) | LetRecursive _ when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,"LetRecursive(...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),"LetRecursive(...)"))) | NewRecord _ when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,"NewRecord(...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),"NewRecord(...)"))) | NewDelegate _ when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,"NewDelegate(...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),"NewDelegate(...)"))) | NewTuple _ when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,"NewTuple(...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),"NewTuple(...)"))) | NewUnionCase (ucase,_) when check -> - raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,"NewUnionCase(" + ucase.Name + "...)"))) + raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),"NewUnionCase(" + ucase.Name + "...)"))) // Error cases | e -> - if check then raise (NotSupportedException (SR.GetString1(SR.unsupportedQueryConstruct,immutQuery.ToString()))) + if check then raise (NotSupportedException (String.Format(SR.GetString(SR.unsupportedQueryConstruct),immutQuery.ToString()))) else TransInnerResult.Source(e),NoConv diff --git a/src/fsharp/FSharp.Core/SR.fs b/src/fsharp/FSharp.Core/SR.fs index 70ec3e94cb..278eb5d88f 100644 --- a/src/fsharp/FSharp.Core/SR.fs +++ b/src/fsharp/FSharp.Core/SR.fs @@ -161,10 +161,3 @@ module internal SR = let GetString(name:System.String) : System.String = resources.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) - let GetString1(name:System.String, arg1:System.String) : System.String = - System.String.Format(resources.GetString(name, System.Globalization.CultureInfo.CurrentUICulture), arg1) - let GetString2(name:System.String, arg1:System.String, arg2:System.String) : System.String = - System.String.Format(resources.GetString(name, System.Globalization.CultureInfo.CurrentUICulture), arg1, arg2) - let GetString3(name:System.String, arg1:System.String, arg2:System.String, arg3:System.String) : System.String = - System.String.Format(resources.GetString(name, System.Globalization.CultureInfo.CurrentUICulture), arg1, arg2, arg3) - diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index bfe1a6af3d..18e8539fc3 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -804,7 +804,7 @@ namespace Microsoft.FSharp.Core //------------------------------------------------------------------------- let FailGenericComparison (obj: obj) = - raise (new System.ArgumentException(SR.GetString1(SR.genericCompareFail1, obj.GetType().ToString()))) + raise (new System.ArgumentException(String.Format(SR.GetString(SR.genericCompareFail1), obj.GetType().ToString()))) /// This type has two instances - fsComparerER and fsComparerThrow. diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 35dbcadb2b..a520286e0c 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -576,13 +576,13 @@ module Patterns = let mems = FSharpType.GetRecordFields(ty,publicOrPrivateBindingFlags) match mems |> Array.tryFind (fun minfo -> minfo.Name = fieldName) with | Some (m) -> m - | _ -> invalidArg "fieldName" (SR.GetString2(SR.QmissingRecordField, ty.FullName, fieldName)) + | _ -> invalidArg "fieldName" (String.Format(SR.GetString(SR.QmissingRecordField), ty.FullName, fieldName)) let getUnionCaseInfo(ty,unionCaseName) = let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags) match cases |> Array.tryFind (fun ucase -> ucase.Name = unionCaseName) with | Some(case) -> case - | _ -> invalidArg "unionCaseName" (SR.GetString2(SR.QmissingUnionCase, ty.FullName, unionCaseName)) + | _ -> invalidArg "unionCaseName" (String.Format(SR.GetString(SR.QmissingUnionCase), ty.FullName, unionCaseName)) let getUnionCaseInfoField(unionCase:UnionCaseInfo,index) = let fields = unionCase.GetFields() @@ -708,7 +708,7 @@ module Patterns = let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags) match cases |> Array.tryFind (fun ucase -> ucase.Name = str) with | Some(case) -> case.GetFields() - | _ -> invalidArg "ty" (SR.GetString1(SR.notAUnionType, ty.FullName)) + | _ -> invalidArg "ty" (String.Format(SR.GetString(SR.notAUnionType), ty.FullName)) let checkBind(v:Var,e) = let ety = typeOf e @@ -1006,14 +1006,14 @@ module Patterns = let bindModuleProperty (ty:Type,nm) = match ty.GetProperty(nm,staticBindingFlags) with - | null -> raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindProperty, nm, ty.ToString())) + | null -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString())) | res -> res // tries to locate unique function in a given type // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution let bindModuleFunction (ty:Type,nm) = match ty.GetMethods(staticBindingFlags) |> Array.filter (fun mi -> mi.Name = nm) with - | [||] -> raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindFunction, nm, ty.ToString())) + | [||] -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) | [| res |] -> Some res | _ -> None @@ -1042,7 +1042,7 @@ module Patterns = let methodTyArgCount = if mi.IsGenericMethod then mi.GetGenericArguments().Length else 0 methodTyArgCount = tyArgs.Length ) - let fail() = raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindFunction, nm, ty.ToString())) + let fail() = raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) match candidates with | [||] -> fail() | [| solution |] -> solution @@ -1150,13 +1150,13 @@ module Patterns = typ.GetProperty(propName, staticOrInstanceBindingFlags) with :? AmbiguousMatchException -> null // more than one property found with the specified name and matching binding constraints - return null to initiate manual search |> bindPropBySearchIfCandidateIsNull typ propName retType (Array.ofList argtyps) - |> checkNonNullResult ("propName", SR.GetString1(SR.QfailedToBindProperty, propName)) // fxcop may not see "propName" as an arg + |> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg #else - typ.GetProperty(propName, staticOrInstanceBindingFlags, null, retType, Array.ofList argtyps, null) |> checkNonNullResult ("propName", SR.GetString1(SR.QfailedToBindProperty, propName)) // fxcop may not see "propName" as an arg + typ.GetProperty(propName, staticOrInstanceBindingFlags, null, retType, Array.ofList argtyps, null) |> checkNonNullResult ("propName", String.Format(SR.GetString(SR.QfailedToBindProperty), propName)) // fxcop may not see "propName" as an arg #endif let bindField (tc,fldName,tyargs) = let typ = mkNamedType(tc,tyargs) - typ.GetField(fldName,staticOrInstanceBindingFlags) |> checkNonNullResult ("fldName", SR.GetString1(SR.QfailedToBindField, fldName)) // fxcop may not see "fldName" as an arg + typ.GetField(fldName,staticOrInstanceBindingFlags) |> checkNonNullResult ("fldName", String.Format(SR.GetString(SR.QfailedToBindField), fldName)) // fxcop may not see "fldName" as an arg let bindGenericCctor (tc:Type) = tc.GetConstructor(staticBindingFlags,null,[| |],null) @@ -1328,7 +1328,7 @@ module Patterns = // For some reason we can get 'null' returned here even when a type with the right name exists... Hence search the slow way... match (ass.GetTypes() |> Array.tryFind (fun a -> a.FullName = tcName)) with | Some ty -> ty - | None -> invalidArg "tcName" (SR.GetString2(SR.QfailedToBindTypeInAssembly, tcName, ass.FullName)) // "Available types are:\n%A" tcName ass (ass.GetTypes() |> Array.map (fun a -> a.FullName)) + | None -> invalidArg "tcName" (String.Format(SR.GetString(SR.QfailedToBindTypeInAssembly), tcName, ass.FullName)) // "Available types are:\n%A" tcName ass (ass.GetTypes() |> Array.map (fun a -> a.FullName)) | ty -> ty let decodeNamedTy tc tsR = mkNamedType(tc,tsR) @@ -1344,7 +1344,7 @@ module Patterns = #else match System.Reflection.Assembly.Load(a) with #endif - | null -> raise <| System.InvalidOperationException(SR.GetString1(SR.QfailedToBindAssembly, a.ToString())) + | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) | ass -> ass let u_NamedType st = @@ -1863,7 +1863,7 @@ module Patterns = | :? MethodInfo as minfo -> if minfo.IsGenericMethod then minfo.GetGenericArguments().Length else 0 | _ -> 0) if (expectedNumTypars <> tyargs.Length) then - invalidArg "tyargs" (SR.GetString3(SR.QwrongNumOfTypeArgs, methodBase.Name, expectedNumTypars.ToString(), tyargs.Length.ToString())); + invalidArg "tyargs" (String.Format(SR.GetString(SR.QwrongNumOfTypeArgs), methodBase.Name, expectedNumTypars.ToString(), tyargs.Length.ToString())); Some(exprBuilder (envClosed tyargs)) | None -> None diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 2f20c4c35b..4c69ddca0b 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -332,7 +332,7 @@ module internal Impl = else "New" + constrname match typ.GetMethod(methname, BindingFlags.Static ||| bindingFlags) with - | null -> raise <| System.InvalidOperationException (SR.GetString1(SR.constructorForUnionCaseNotFound, methname)) + | null -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.constructorForUnionCaseNotFound), methname)) | meth -> meth let getUnionCaseConstructor (typ:Type,tag:int,bindingFlags) = @@ -347,9 +347,9 @@ module internal Impl = checkNonNull "unionType" unionType; if not (isUnionType (unionType,bindingFlags)) then if isUnionType (unionType,bindingFlags ||| BindingFlags.NonPublic) then - invalidArg "unionType" (SR.GetString1(SR.privateUnionType, unionType.FullName)) + invalidArg "unionType" (String.Format(SR.GetString(SR.privateUnionType), unionType.FullName)) else - invalidArg "unionType" (SR.GetString1(SR.notAUnionType, unionType.FullName)) + invalidArg "unionType" (String.Format(SR.GetString(SR.notAUnionType), unionType.FullName)) //----------------------------------------------------------------- // TUPLE DECOMPILATION @@ -435,7 +435,7 @@ module internal Impl = | _ -> invalidArg "tys" (SR.GetString(SR.invalidTupleTypes)) let rec getTupleTypeInfo (typ:Type) = - if not (isTupleType (typ) ) then invalidArg "typ" (SR.GetString1(SR.notATupleType, typ.FullName)); + if not (isTupleType (typ) ) then invalidArg "typ" (String.Format(SR.GetString(SR.notATupleType), typ.FullName)); let tyargs = typ.GetGenericArguments() if tyargs.Length = maxTuple then let tysA = tyargs.[0..tupleEncField-1] @@ -507,7 +507,7 @@ module internal Impl = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags,null,props |> Array.map (fun p -> p.PropertyType),null) #endif match ctor with - | null -> raise <| ArgumentException(SR.GetString1(SR.invalidTupleTypeConstructorNotDefined, typ.FullName)) + | null -> raise <| ArgumentException(String.Format(SR.GetString(SR.invalidTupleTypeConstructorNotDefined), typ.FullName)) | _ -> () ctor @@ -561,16 +561,16 @@ module internal Impl = maker1,Some(etys.[tupleEncField]) let getTupleReaderInfo (typ:Type,index:int) = - if index < 0 then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString())) + if index < 0 then invalidArg "index" (String.Format(SR.GetString(SR.tupleIndexOutOfRange), typ.FullName, index.ToString())) let get index = if typ.IsValueType then let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties - if index >= props.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString())) + if index >= props.Length then invalidArg "index" (String.Format(SR.GetString(SR.tupleIndexOutOfRange), typ.FullName, index.ToString())) props.[index] else let props = typ.GetProperties(instancePropertyFlags ||| BindingFlags.Public) |> orderTupleProperties - if index >= props.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, typ.FullName, index.ToString())) + if index >= props.Length then invalidArg "index" (String.Format(SR.GetString(SR.tupleIndexOutOfRange), typ.FullName, index.ToString())) props.[index] if index < tupleEncField then @@ -584,7 +584,7 @@ module internal Impl = let getFunctionTypeInfo (typ:Type) = - if not (isFunctionType typ) then invalidArg "typ" (SR.GetString1(SR.notAFunctionType, typ.FullName)) + if not (isFunctionType typ) then invalidArg "typ" (String.Format(SR.GetString(SR.notAFunctionType), typ.FullName)) let tyargs = typ.GetGenericArguments() tyargs.[0], tyargs.[1] @@ -632,7 +632,7 @@ module internal Impl = let ctor = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags,null,props |> Array.map (fun p -> p.PropertyType),null) #endif match ctor with - | null -> raise <| ArgumentException(SR.GetString1(SR.invalidRecordTypeConstructorNotDefined, typ.FullName)) + | null -> raise <| ArgumentException(String.Format(SR.GetString(SR.invalidRecordTypeConstructorNotDefined), typ.FullName)) | _ -> () ctor @@ -676,21 +676,21 @@ module internal Impl = let checkExnType (exceptionType, bindingFlags) = if not (isExceptionRepr (exceptionType,bindingFlags)) then if isExceptionRepr (exceptionType,bindingFlags ||| BindingFlags.NonPublic) then - invalidArg "exceptionType" (SR.GetString1(SR.privateExceptionType, exceptionType.FullName)) + invalidArg "exceptionType" (String.Format(SR.GetString(SR.privateExceptionType), exceptionType.FullName)) else - invalidArg "exceptionType" (SR.GetString1(SR.notAnExceptionType, exceptionType.FullName)) + invalidArg "exceptionType" (String.Format(SR.GetString(SR.notAnExceptionType), exceptionType.FullName)) let checkRecordType(argName,recordType,bindingFlags) = checkNonNull argName recordType; if not (isRecordType (recordType,bindingFlags) ) then if isRecordType (recordType,bindingFlags ||| BindingFlags.NonPublic) then - invalidArg argName (SR.GetString1(SR.privateRecordType, recordType.FullName)) + invalidArg argName (String.Format(SR.GetString(SR.privateRecordType), recordType.FullName)) else - invalidArg argName (SR.GetString1(SR.notARecordType, recordType.FullName)) + invalidArg argName (String.Format(SR.GetString(SR.notARecordType), recordType.FullName)) let checkTupleType(argName,(tupleType:Type)) = checkNonNull argName tupleType; - if not (isTupleType tupleType) then invalidArg argName (SR.GetString1(SR.notATupleType, tupleType.FullName)) + if not (isTupleType tupleType) then invalidArg argName (String.Format(SR.GetString(SR.notATupleType), tupleType.FullName)) #if FX_RESHAPED_REFLECTION open ReflectionAdapters @@ -862,7 +862,7 @@ type FSharpValue = static member MakeFunction(functionType:Type,implementation:(obj->obj)) = Impl.checkNonNull "functionType" functionType - if not (Impl.isFunctionType functionType) then invalidArg "functionType" (SR.GetString1(SR.notAFunctionType, functionType.FullName)); + if not (Impl.isFunctionType functionType) then invalidArg "functionType" (String.Format(SR.GetString(SR.notAFunctionType), functionType.FullName)); Impl.checkNonNull "implementation" implementation let domain,range = Impl.getFunctionTypeInfo functionType let dynCloMakerTy = typedefof> @@ -879,15 +879,15 @@ type FSharpValue = static member GetTupleFields(tuple:obj) = // argument name(s) used in error message Impl.checkNonNull "tuple" tuple let typ = tuple.GetType() - if not (Impl.isTupleType typ ) then invalidArg "tuple" (SR.GetString1(SR.notATupleType, tuple.GetType().FullName)); + if not (Impl.isTupleType typ ) then invalidArg "tuple" (String.Format(SR.GetString(SR.notATupleType), tuple.GetType().FullName)); Impl.getTupleReader typ tuple static member GetTupleField(tuple:obj,index:int) = // argument name(s) used in error message Impl.checkNonNull "tuple" tuple let typ = tuple.GetType() - if not (Impl.isTupleType typ ) then invalidArg "tuple" (SR.GetString1(SR.notATupleType, tuple.GetType().FullName)); + if not (Impl.isTupleType typ ) then invalidArg "tuple" (String.Format(SR.GetString(SR.notATupleType), tuple.GetType().FullName)); let fields = Impl.getTupleReader typ tuple - if index < 0 || index >= fields.Length then invalidArg "index" (SR.GetString2(SR.tupleIndexOutOfRange, tuple.GetType().FullName, index.ToString())); + if index < 0 || index >= fields.Length then invalidArg "index" (String.Format(SR.GetString(SR.tupleIndexOutOfRange), tuple.GetType().FullName, index.ToString())); fields.[index] static member PreComputeTupleReader(tupleType:Type) : (obj -> obj[]) = diff --git a/src/fsharp/Fsc-proto/Fsc-proto.fsproj b/src/fsharp/Fsc-proto/Fsc-proto.fsproj index 7b554d80c8..1f86f23372 100644 --- a/src/fsharp/Fsc-proto/Fsc-proto.fsproj +++ b/src/fsharp/Fsc-proto/Fsc-proto.fsproj @@ -443,10 +443,7 @@ fscmain.fs - - fsc-proto.exe.config - PreserveNewest - + @@ -465,7 +462,7 @@ $(FSharpSourcesRoot)\..\packages\System.Reflection.Metadata.1.4.2\lib\portable-net45+win8\System.Reflection.Metadata.dll - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll $(FSharpSourcesRoot)\..\packages\System.ValueTuple.4.3.1\lib\netstandard1.0\System.ValueTuple.dll diff --git a/src/fsharp/Fsc-proto/app.config b/src/fsharp/Fsc-proto/app.config new file mode 100644 index 0000000000..46b5e39962 --- /dev/null +++ b/src/fsharp/Fsc-proto/app.config @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/src/fsharp/Fsc-proto/fsc-proto.exe.config b/src/fsharp/Fsc-proto/fsc-proto.exe.config deleted file mode 100644 index dc90fef34d..0000000000 --- a/src/fsharp/Fsc-proto/fsc-proto.exe.config +++ /dev/null @@ -1,5 +0,0 @@ - - - - - diff --git a/src/fsharp/Fsc/Fsc.fsproj b/src/fsharp/Fsc/Fsc.fsproj index 5ed2857ea7..5e820e75ea 100644 --- a/src/fsharp/Fsc/Fsc.fsproj +++ b/src/fsharp/Fsc/Fsc.fsproj @@ -40,10 +40,7 @@ fscmain.fs - - fsc.exe.config - PreserveNewest - + default.win32manifest PreserveNewest diff --git a/src/fsharp/Fsc/fsc.exe.config b/src/fsharp/Fsc/app.config similarity index 66% rename from src/fsharp/Fsc/fsc.exe.config rename to src/fsharp/Fsc/app.config index b634d92c0b..493b8a7276 100644 --- a/src/fsharp/Fsc/fsc.exe.config +++ b/src/fsharp/Fsc/app.config @@ -8,6 +8,10 @@ + + + + diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 4fafb20040..dcc8233314 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -2072,7 +2072,14 @@ and GenConstant cenv cgbuf eenv (c,m,ty) sequel = | Const.SByte i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 i) - | Const.Int64 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcInt64 i) + | Const.Int64 i -> + // see https://github.com/Microsoft/visualfsharp/pull/3620 + if i >= int64 System.Int32.MinValue && i <= int64 System.Int32.MaxValue then + CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ] + elif i >= int64 System.UInt32.MinValue && i <= int64 System.UInt32.MaxValue then + CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdcInt32 (int32 i); AI_conv DT_U8 ] + else + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcInt64 i) | Const.IntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [iLdcInt64 i; AI_conv DT_I ] | Const.Byte i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.UInt16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index f37d6535ed..5b9deaf832 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -4,7 +4,6 @@ /// Implements the offside rule and a copule of other lexical transformations. module internal Microsoft.FSharp.Compiler.LexFilter -open Internal.Utilities open Internal.Utilities.Text.Lexing open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL @@ -13,7 +12,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger -open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Parser open Microsoft.FSharp.Compiler.Lexhelp diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 26916e6d83..1ab013976c 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -10,16 +10,18 @@ module public Microsoft.FSharp.Compiler.PrettyNaming #else module internal Microsoft.FSharp.Compiler.PrettyNaming #endif -open Internal.Utilities - open Microsoft.FSharp.Compiler - open Microsoft.FSharp.Compiler.AbstractIL.Internal - open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library - open System.Globalization + open System open System.Collections.Generic open System.Collections.Concurrent + open System.Globalization + open System.Text + + open Microsoft.FSharp.Compiler + open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library - module TaggedTextOps = Internal.Utilities.StructuredFormat.TaggedTextOps - module LayoutOps = Internal.Utilities.StructuredFormat.LayoutOps + open Internal.Utilities + open Internal.Utilities.StructuredFormat + open Internal.Utilities.StructuredFormat.LayoutOps #if FX_RESHAPED_REFLECTION open Microsoft.FSharp.Core.ReflectionAdapters @@ -38,89 +40,89 @@ open Internal.Utilities let [] opNamePrefix = "op_" let private opNameTable = - [|("[]", "op_Nil"); - ("::", "op_ColonColon"); - ("+", "op_Addition"); - ("~%", "op_Splice"); - ("~%%", "op_SpliceUntyped"); - ("~++", "op_Increment"); - ("~--", "op_Decrement"); - ("-", "op_Subtraction"); - ("*", "op_Multiply"); - ("**", "op_Exponentiation"); - ("/", "op_Division"); - ("@", "op_Append"); - ("^", "op_Concatenate"); - ("%", "op_Modulus"); - ("&&&", "op_BitwiseAnd"); - ("|||", "op_BitwiseOr"); - ("^^^", "op_ExclusiveOr"); - ("<<<", "op_LeftShift"); - ("~~~", "op_LogicalNot"); - (">>>", "op_RightShift"); - ("~+", "op_UnaryPlus"); - ("~-", "op_UnaryNegation"); - ("~&", "op_AddressOf"); - ("~&&", "op_IntegerAddressOf"); - ("&&", "op_BooleanAnd"); - ("||", "op_BooleanOr"); - ("<=", "op_LessThanOrEqual"); - ("=","op_Equality"); - ("<>","op_Inequality"); - (">=", "op_GreaterThanOrEqual"); - ("<", "op_LessThan"); - (">", "op_GreaterThan"); - ("|>", "op_PipeRight"); - ("||>", "op_PipeRight2"); - ("|||>", "op_PipeRight3"); - ("<|", "op_PipeLeft"); - ("<||", "op_PipeLeft2"); - ("<|||", "op_PipeLeft3"); - ("!", "op_Dereference"); - (">>", "op_ComposeRight"); - ("<<", "op_ComposeLeft"); - ("<< >>", "op_TypedQuotationUnicode"); - ("<<| |>>", "op_ChevronsBar"); - ("<@ @>", "op_Quotation"); - ("<@@ @@>", "op_QuotationUntyped"); - ("+=", "op_AdditionAssignment"); - ("-=", "op_SubtractionAssignment"); - ("*=", "op_MultiplyAssignment"); - ("/=", "op_DivisionAssignment"); - ("..", "op_Range"); - (".. ..", "op_RangeStep"); - (qmark, "op_Dynamic"); - (qmarkSet, "op_DynamicAssignment"); - (parenGet, "op_ArrayLookup"); - (parenSet, "op_ArrayAssign"); + [|("[]", "op_Nil") + ("::", "op_ColonColon") + ("+", "op_Addition") + ("~%", "op_Splice") + ("~%%", "op_SpliceUntyped") + ("~++", "op_Increment") + ("~--", "op_Decrement") + ("-", "op_Subtraction") + ("*", "op_Multiply") + ("**", "op_Exponentiation") + ("/", "op_Division") + ("@", "op_Append") + ("^", "op_Concatenate") + ("%", "op_Modulus") + ("&&&", "op_BitwiseAnd") + ("|||", "op_BitwiseOr") + ("^^^", "op_ExclusiveOr") + ("<<<", "op_LeftShift") + ("~~~", "op_LogicalNot") + (">>>", "op_RightShift") + ("~+", "op_UnaryPlus") + ("~-", "op_UnaryNegation") + ("~&", "op_AddressOf") + ("~&&", "op_IntegerAddressOf") + ("&&", "op_BooleanAnd") + ("||", "op_BooleanOr") + ("<=", "op_LessThanOrEqual") + ("=","op_Equality") + ("<>","op_Inequality") + (">=", "op_GreaterThanOrEqual") + ("<", "op_LessThan") + (">", "op_GreaterThan") + ("|>", "op_PipeRight") + ("||>", "op_PipeRight2") + ("|||>", "op_PipeRight3") + ("<|", "op_PipeLeft") + ("<||", "op_PipeLeft2") + ("<|||", "op_PipeLeft3") + ("!", "op_Dereference") + (">>", "op_ComposeRight") + ("<<", "op_ComposeLeft") + ("<< >>", "op_TypedQuotationUnicode") + ("<<| |>>", "op_ChevronsBar") + ("<@ @>", "op_Quotation") + ("<@@ @@>", "op_QuotationUntyped") + ("+=", "op_AdditionAssignment") + ("-=", "op_SubtractionAssignment") + ("*=", "op_MultiplyAssignment") + ("/=", "op_DivisionAssignment") + ("..", "op_Range") + (".. ..", "op_RangeStep") + (qmark, "op_Dynamic") + (qmarkSet, "op_DynamicAssignment") + (parenGet, "op_ArrayLookup") + (parenSet, "op_ArrayAssign") |] let private opCharTranslateTable = - [|( '>', "Greater"); - ( '<', "Less"); - ( '+', "Plus"); - ( '-', "Minus"); - ( '*', "Multiply"); - ( '=', "Equals"); - ( '~', "Twiddle"); - ( '%', "Percent"); - ( '.', "Dot"); - ( '$', "Dollar"); - ( '&', "Amp"); - ( '|', "Bar"); - ( '@', "At"); - ( '#', "Hash"); - ( '^', "Hat"); - ( '!', "Bang"); - ( '?', "Qmark"); - ( '/', "Divide"); - ( ':', "Colon"); - ( '(', "LParen"); - ( ',', "Comma"); - ( ')', "RParen"); - ( ' ', "Space"); - ( '[', "LBrack"); - ( ']', "RBrack"); |] + [|( '>', "Greater") + ( '<', "Less") + ( '+', "Plus") + ( '-', "Minus") + ( '*', "Multiply") + ( '=', "Equals") + ( '~', "Twiddle") + ( '%', "Percent") + ( '.', "Dot") + ( '$', "Dollar") + ( '&', "Amp") + ( '|', "Bar") + ( '@', "At") + ( '#', "Hash") + ( '^', "Hat") + ( '!', "Bang") + ( '?', "Qmark") + ( '/', "Divide") + ( ':', "Colon") + ( '(', "LParen") + ( ',', "Comma") + ( ')', "RParen") + ( ' ', "Space") + ( '[', "LBrack") + ( ']', "RBrack") |] /// The set of characters usable in custom operators. let private opCharSet = @@ -144,17 +146,16 @@ open Internal.Utilities res let IsMangledOpName (n:string) = - n.StartsWith (opNamePrefix, System.StringComparison.Ordinal) + n.StartsWith (opNamePrefix, StringComparison.Ordinal) - // +++ GLOBAL STATE /// Compiles a custom operator into a mangled operator name. /// For example, "!%" becomes "op_DereferencePercent". - /// This function should only be used for custom operators; + /// This function should only be used for custom operators /// if an operator is or potentially may be a built-in operator, /// use the 'CompileOpName' function instead. let private compileCustomOpName = let t2 = - let t2 = Dictionary<_,_> (opCharTranslateTable.Length) + let t2 = Dictionary<_, _> (opCharTranslateTable.Length) for x, y in opCharTranslateTable do t2.Add (x, y) t2 @@ -168,13 +169,13 @@ open Internal.Utilities /// Memoize compilation of custom operators. /// They're typically used more than once so this avoids some CPU and GC overhead. - let compiledOperators = ConcurrentDictionary<_,string> (System.StringComparer.Ordinal) + let compiledOperators = ConcurrentDictionary<_, string> (StringComparer.Ordinal) fun opp -> // Has this operator already been compiled? compiledOperators.GetOrAdd(opp, fun (op:string) -> let opLength = op.Length - let sb = new System.Text.StringBuilder (opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) + let sb = new Text.StringBuilder (opNamePrefix, opNamePrefix.Length + (opLength * maxOperatorNameLength)) for i = 0 to opLength - 1 do let c = op.[i] match t2.TryGetValue c with @@ -189,14 +190,13 @@ open Internal.Utilities // Cache the compiled name so it can be reused. opName) - // +++ GLOBAL STATE /// Compiles an operator into a mangled operator name. /// For example, "!%" becomes "op_DereferencePercent". /// This function accepts both built-in and custom operators. let CompileOpName = /// Maps the built-in F# operators to their mangled operator names. let standardOpNames = - let opNames = Dictionary<_,_> (opNameTable.Length, System.StringComparer.Ordinal) + let opNames = Dictionary<_, _> (opNameTable.Length, StringComparer.Ordinal) for x, y in opNameTable do opNames.Add (x, y) opNames @@ -209,16 +209,15 @@ open Internal.Utilities compileCustomOpName op else op - // +++ GLOBAL STATE /// Decompiles the mangled name of a custom operator back into an operator. /// For example, "op_DereferencePercent" becomes "!%". - /// This function should only be used for mangled names of custom operators; + /// This function should only be used for mangled names of custom operators /// if a mangled name potentially represents a built-in operator, /// use the 'DecompileOpName' function instead. let private decompileCustomOpName = // Memoize this operation. Custom operators are typically used more than once // so this avoids repeating decompilation. - let decompiledOperators = ConcurrentDictionary<_,_> (System.StringComparer.Ordinal) + let decompiledOperators = ConcurrentDictionary<_, _> (StringComparer.Ordinal) /// The minimum length of the name for a custom operator character. /// This value is used when initializing StringBuilders to avoid resizing. @@ -236,9 +235,9 @@ open Internal.Utilities let opNameLen = opName.Length /// Function which decompiles the mangled operator name back into a string of operator characters. - /// Returns None if the name contains text which doesn't correspond to an operator; + /// Returns None if the name contains text which doesn't correspond to an operator /// otherwise returns Some containing the original operator. - let rec decompile (sb : System.Text.StringBuilder) idx = + let rec decompile (sb : StringBuilder) idx = // Have we reached the end of 'opName'? if idx = opNameLen then // Finished decompiling. @@ -256,7 +255,7 @@ open Internal.Utilities if opNameLen - idx < opCharNameLen then false else // Does 'opCharName' match the current position in 'opName'? - System.String.Compare (opName, idx, opCharName, 0, opCharNameLen, System.StringComparison.Ordinal) = 0) + String.Compare (opName, idx, opCharName, 0, opCharNameLen, StringComparison.Ordinal) = 0) match choice with | None -> @@ -274,19 +273,19 @@ open Internal.Utilities /// The maximum number of operator characters that could be contained in the /// decompiled operator given the length of the mangled custom operator name. let maxPossibleOpCharCount = (opNameLen - opNamePrefixLen) / minOperatorNameLength - System.Text.StringBuilder (maxPossibleOpCharCount) + StringBuilder (maxPossibleOpCharCount) // Start decompiling just after the operator prefix. decompile sb opNamePrefixLen - // +++ GLOBAL STATE + /// Decompiles a mangled operator name back into an operator. /// For example, "op_DereferencePercent" becomes "!%". /// This function accepts mangled names for both built-in and custom operators. let DecompileOpName = /// Maps the mangled operator names of built-in F# operators back to the operators. let standardOps = - let ops = Dictionary (opNameTable.Length, System.StringComparer.Ordinal) + let ops = Dictionary (opNameTable.Length, StringComparer.Ordinal) for x, y in opNameTable do ops.Add(y,x) ops @@ -305,14 +304,13 @@ open Internal.Utilities if IsOperatorOrBacktickedName nm then "( " + nm + " )" else nm - open LayoutOps - let DemangleOperatorNameAsLayout nonOpTagged nm = let nm = DecompileOpName nm if IsOperatorOrBacktickedName nm then wordL (TaggedTextOps.tagPunctuation "(") ^^ wordL (TaggedTextOps.tagOperator nm) ^^ wordL (TaggedTextOps.tagPunctuation ")") - else LayoutOps.wordL (nonOpTagged nm) + else wordL (nonOpTagged nm) let opNameCons = CompileOpName "::" + let opNameNil = CompileOpName "[]" let opNameEquals = CompileOpName "=" let opNameEqualsNullable = CompileOpName "=?" @@ -323,7 +321,7 @@ open Internal.Utilities let IsIdentifierFirstCharacter c = if c = '_' then true else - match System.Char.GetUnicodeCategory c with + match Char.GetUnicodeCategory c with // Letters | UnicodeCategory.UppercaseLetter | UnicodeCategory.LowercaseLetter @@ -337,7 +335,7 @@ open Internal.Utilities let IsIdentifierPartCharacter c = if c = '\'' then true // Tick else - match System.Char.GetUnicodeCategory c with + match Char.GetUnicodeCategory c with // Letters | UnicodeCategory.UppercaseLetter | UnicodeCategory.LowercaseLetter @@ -360,7 +358,7 @@ open Internal.Utilities || IsIdentifierPartCharacter c let IsValidPrefixOperatorUse s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "?+" | "?-" | "+" | "-" | "+." | "-." | "%" | "%%" | "&" | "&&" -> true | _ -> @@ -370,7 +368,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsValidPrefixOperatorDefinitionName s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "~?+" | "~?-" | "~+" | "~-" | "~+." | "~-." | "~%" | "~%%" | "~&" | "~&&" -> true | _ -> @@ -380,7 +378,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsPrefixOperator s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else let s = DecompileOpName s match s with | "~?+" | "~?-" | "~+" | "~-" | "~+." | "~-." | "~%" | "~%%" | "~&" | "~&&" -> true @@ -391,7 +389,7 @@ open Internal.Utilities || (s.[0] = '~' && String.forall (fun c -> c = '~') s) let IsPunctuation s = - if System.String.IsNullOrEmpty s then false else + if String.IsNullOrEmpty s then false else match s with | "," | ";" | "|" | ":" | "." | "*" | "(" | ")" @@ -407,12 +405,16 @@ open Internal.Utilities (DecompileOpName s = qmarkSet) let IsInfixOperator = + /// EQUALS, INFIX_COMPARE_OP, LESS, GREATER let relational = [| "=";"!=";"<";">";"$"|] + /// INFIX_AT_HAT_OP let concat = [| "@";"^" |] + /// PLUS_MINUS_OP, MINUS let plusMinus = [| "+"; "-" |] + /// PERCENT_OP, STAR, INFIX_STAR_DIV_MOD_OP let otherMath = [| "*";"/";"%" |] @@ -429,13 +431,12 @@ open Internal.Utilities // This function recognises these "infix operator" names. let s = DecompileOpName s let skipIgnoredChars = s.TrimStart(ignoredChars) - let afterSkipStartsWith prefix = skipIgnoredChars.StartsWith(prefix,System.StringComparison.Ordinal) + let afterSkipStartsWith prefix = skipIgnoredChars.StartsWith(prefix,StringComparison.Ordinal) let afterSkipStarts prefixes = Array.exists afterSkipStartsWith prefixes // The following conditions follow the declExpr infix clauses. // The test corresponds to the lexer definition for the token. s = ":=" || // COLON_EQUALS afterSkipStartsWith "|" || // BAR_BAR, INFIX_BAR_OP - (* REVIEW: OR is deadcode, now called BAR? *) // OR afterSkipStartsWith "&" || // AMP, AMP_AMP, INFIX_AMP_OP afterSkipStarts relational || // EQUALS, INFIX_COMPARE_OP, LESS, GREATER s = "$" || // DOLLAR @@ -461,6 +462,7 @@ open Internal.Utilities Other let [] private compilerGeneratedMarker = "@" + let [] private compilerGeneratedMarkerChar = '@' let IsCompilerGeneratedName (nm:string) = @@ -483,6 +485,7 @@ open Internal.Utilities //------------------------------------------------------------------------- let [] private mangledGenericTypeNameSym = '`' + let IsMangledGenericName (n:string) = n.IndexOf mangledGenericTypeNameSym <> -1 && (* check what comes after the symbol is a number *) @@ -493,6 +496,7 @@ open Internal.Utilities res type NameArityPair = NameArityPair of string * int + let DecodeGenericTypeName n = if IsMangledGenericName n then let pos = n.LastIndexOf mangledGenericTypeNameSym @@ -507,16 +511,7 @@ open Internal.Utilities n.Substring(0,pos) else n - //------------------------------------------------------------------------- - // Property name mangling. - // Expecting s to be in the form (as returned by qualifiedMangledNameOfTyconRef) of: - // get_P or set_P - // Names/Space/Class/NLPath-get_P or Names/Space/Class/NLPath.set_P - // Required to return "P" - //------------------------------------------------------------------------- - let private chopStringTo (s:string) (c:char) = - (* chopStringTo "abcdef" 'c' --> "def" *) match s.IndexOf c with | -1 -> s | idx -> @@ -527,13 +522,13 @@ open Internal.Utilities let TryChopPropertyName (s: string) = // extract the logical name from any mangled name produced by MakeMemberDataAndMangledNameForMemberVal if s.Length <= 4 then None else - if s.StartsWith("get_", System.StringComparison.Ordinal) || - s.StartsWith("set_", System.StringComparison.Ordinal) + if s.StartsWith("get_", StringComparison.Ordinal) || + s.StartsWith("set_", StringComparison.Ordinal) then Some (s.Substring(4, s.Length - 4)) else let s = chopStringTo s '.' - if s.StartsWith("get_", System.StringComparison.Ordinal) || - s.StartsWith("set_", System.StringComparison.Ordinal) + if s.StartsWith("get_", StringComparison.Ordinal) || + s.StartsWith("set_", StringComparison.Ordinal) then Some (s.Substring(4, s.Length - 4)) else None @@ -546,11 +541,11 @@ open Internal.Utilities | Some res -> res let SplitNamesForILPath (s : string) : string list = - if s.StartsWith("``",System.StringComparison.Ordinal) && s.EndsWith("``",System.StringComparison.Ordinal) && s.Length > 4 then [s.Substring(2, s.Length-4)] // identifier is enclosed in `` .. ``, so it is only a single element (this is very approximate) + if s.StartsWith("``",StringComparison.Ordinal) && s.EndsWith("``",StringComparison.Ordinal) && s.Length > 4 then [s.Substring(2, s.Length-4)] // identifier is enclosed in `` .. ``, so it is only a single element (this is very approximate) else s.Split [| '.' ; '`' |] |> Array.toList // '.' chops members / namespaces / modules; '`' chops generic parameters for .NET types - // Return a string array delimited by the given separator. - // Note that a quoted string is not going to be mangled into pieces. + /// Return a string array delimited by the given separator. + /// Note that a quoted string is not going to be mangled into pieces. let private splitAroundQuotation (text:string) (separator:char) = let length = text.Length let isNotQuotedQuotation n = n > 0 && text.[n-1] <> '\\' @@ -560,20 +555,20 @@ open Internal.Utilities // split when seeing a separator | c, false when c = separator -> split (i+1, "", cur::group, false) // keep reading if a separator is inside quotation - | c, true when c = separator -> split (i+1, cur+(System.Char.ToString c), group, true) + | c, true when c = separator -> split (i+1, cur+(Char.ToString c), group, true) // open or close quotation | '\"', _ when isNotQuotedQuotation i -> split (i+1, cur+"\"", group, not insideQuotation) // keep reading - | c, _ -> split (i+1, cur+(System.Char.ToString c), group, insideQuotation) + | c, _ -> split (i+1, cur+(Char.ToString c), group, insideQuotation) split (0, "", [], false) |> Array.ofList - // Return a string array delimited by the given separator up to the maximum number. - // Note that a quoted string is not going to be mangled into pieces. + /// Return a string array delimited by the given separator up to the maximum number. + /// Note that a quoted string is not going to be mangled into pieces. let private splitAroundQuotationWithCount (text:string) (separator:char) (count:int)= if count <= 1 then [| text |] else let mangledText = splitAroundQuotation text separator match mangledText.Length > count with - | true -> Array.append (mangledText.[0..(count-2)]) ([| mangledText.[(count-1)..] |> String.concat (System.Char.ToString separator) |]) + | true -> Array.append (mangledText.[0..(count-2)]) ([| mangledText.[(count-1)..] |> String.concat (Char.ToString separator) |]) | false -> mangledText let [] FSharpModuleSuffix = "Module" @@ -606,9 +601,13 @@ open Internal.Utilities type ActivePatternInfo = | APInfo of bool * (string * Range.range) list * Range.range + member x.IsTotal = let (APInfo(p,_,_)) = x in p + member x.ActiveTags = let (APInfo(_,tags,_)) = x in List.map fst tags + member x.ActiveTagsWithRanges = let (APInfo(_,tags,_)) = x in tags + member x.Range = let (APInfo(_,_,m)) = x in m let ActivePatternInfoOfValName nm (m:Range.range) = @@ -646,9 +645,9 @@ open Internal.Utilities Some(nm,v) | _ -> None - // Demangle the static parameters exception InvalidMangledStaticArg of string + /// Demangle the static parameters let demangleProvidedTypeName (typeLogicalName:string) = if typeLogicalName.Contains "," then let pieces = splitAroundQuotation typeLogicalName ',' @@ -663,7 +662,8 @@ open Internal.Utilities else typeLogicalName, [| |] - let mangleProvidedTypeName (typeLogicalName,nonDefaultArgs) = + /// Mangle the static parameters for a provided type or method + let mangleProvidedTypeName (typeLogicalName, nonDefaultArgs) = let nonDefaultArgsText = nonDefaultArgs |> Array.map mangleStaticStringArg @@ -675,7 +675,8 @@ open Internal.Utilities typeLogicalName + "," + nonDefaultArgsText - let computeMangledNameWithoutDefaultArgValues(nm,staticArgs,defaultArgValues) = + /// Mangle the static parameters for a provided type or method + let computeMangledNameWithoutDefaultArgValues(nm, staticArgs, defaultArgValues) = let nonDefaultArgs = (staticArgs,defaultArgValues) ||> Array.zip diff --git a/src/fsharp/ReferenceResolver.fs b/src/fsharp/ReferenceResolver.fs index 805e1050aa..dd4ca025a5 100644 --- a/src/fsharp/ReferenceResolver.fs +++ b/src/fsharp/ReferenceResolver.fs @@ -28,6 +28,7 @@ module internal ReferenceResolver = override this.ToString() = sprintf "ResolvedFile(%s)" this.itemSpec + [] type Resolver = /// Get the "v4.5.1"-style moniker for the highest installed .NET Framework version. /// This is the value passed back to Resolve if no explicit "mscorlib" has been given. diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index bacef03b43..10e8897d60 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -34,12 +34,12 @@ let ffailwith fileName str = [] type PickledDataWithReferences<'rawData> = { /// The data that uses a collection of CcuThunks internally - RawData: 'rawData; + RawData: 'rawData /// The assumptions that need to be fixed up FixupThunks: list } member x.Fixup loader = - x.FixupThunks |> List.iter (fun reqd -> reqd.Fixup(loader reqd.AssemblyName)) ; + x.FixupThunks |> List.iter (fun reqd -> reqd.Fixup(loader reqd.AssemblyName)) x.RawData /// Like Fixup but loader may return None, in which case there is no fixup. @@ -48,7 +48,7 @@ type PickledDataWithReferences<'rawData> = |> List.iter(fun reqd-> match loader reqd.AssemblyName with | Some(loaded) -> reqd.Fixup(loaded) - | None -> reqd.FixupOrphaned() ); + | None -> reqd.FixupOrphaned() ) x.RawData @@ -59,16 +59,16 @@ type PickledDataWithReferences<'rawData> = [] type Table<'T> = { name: string; - tbl: Dictionary<'T, int>; - mutable rows: ResizeArray<'T>; + tbl: Dictionary<'T, int> + mutable rows: ResizeArray<'T> mutable count: int } member tbl.AsArray = Seq.toArray tbl.rows member tbl.Size = tbl.rows.Count member tbl.Add x = let n = tbl.count - tbl.count <- tbl.count + 1; - tbl.tbl.[x] <- n; - tbl.rows.Add(x); + tbl.count <- tbl.count + 1 + tbl.tbl.[x] <- n + tbl.rows.Add(x) n member tbl.FindOrAdd x = let mutable res = Unchecked.defaultof<_> @@ -77,14 +77,14 @@ type Table<'T> = static member Create n = - { name = n; - tbl = new System.Collections.Generic.Dictionary<_,_>(1000, HashIdentity.Structural); - rows= new ResizeArray<_>(1000); - count=0; } + { name = n + tbl = new System.Collections.Generic.Dictionary<_,_>(1000, HashIdentity.Structural) + rows= new ResizeArray<_>(1000) + count=0 } [] type InputTable<'T> = - { itbl_name: string; + { itbl_name: string itbl_rows: 'T array } let new_itbl n r = { itbl_name=n; itbl_rows=r } @@ -110,18 +110,20 @@ type NodeOutTable<'Data,'Node> = [] type WriterState = - { os: ByteBuffer; - oscope: CcuThunk; - occus: Table; - otycons: NodeOutTable; - otypars: NodeOutTable; - ovals: NodeOutTable; - ostrings: Table; - opubpaths: Table; - onlerefs: Table; - osimpletyps: Table; - oglobals : TcGlobals; - ofile : string; + { os: ByteBuffer + oscope: CcuThunk + occus: Table + otycons: NodeOutTable + otypars: NodeOutTable + ovals: NodeOutTable + ostrings: Table + opubpaths: Table + onlerefs: Table + osimpletyps: Table + oglobals : TcGlobals + ofile : string + /// Indicates if we are using in-memory format, where we store XML docs as well + oInMem : bool } let pfailwith st str = ffailwith st.ofile str @@ -139,17 +141,17 @@ type NodeInTable<'Data,'Node> = [] type ReaderState = - { is: ByteStream; - iilscope: ILScopeRef; - iccus: InputTable; - itycons: NodeInTable; - itypars: NodeInTable; - ivals: NodeInTable; - istrings: InputTable; - ipubpaths: InputTable; - inlerefs: InputTable; - isimpletyps: InputTable; - ifile: string; + { is: ByteStream + iilscope: ILScopeRef + iccus: InputTable + itycons: NodeInTable + itypars: NodeInTable + ivals: NodeInTable + istrings: InputTable + ipubpaths: InputTable + inlerefs: InputTable + isimpletyps: InputTable + ifile: string iILModule : ILModuleDef option // the Abstract IL metadata for the DLL being read } @@ -164,9 +166,9 @@ type 'T pickler = 'T -> WriterState -> unit let p_byte b st = st.os.EmitIntAsByte b let p_bool b st = p_byte (if b then 1 else 0) st let prim_p_int32 i st = - p_byte (b0 i) st; - p_byte (b1 i) st; - p_byte (b2 i) st; + p_byte (b0 i) st + p_byte (b1 i) st + p_byte (b2 i) st p_byte (b3 i) st /// Compress integers according to the same scheme used by CLR metadata @@ -175,10 +177,10 @@ let p_int32 n st = if n >= 0 && n <= 0x7F then p_byte (b0 n) st else if n >= 0x80 && n <= 0x3FFF then - p_byte ( (0x80 ||| (n >>> 8))) st; + p_byte ( (0x80 ||| (n >>> 8))) st p_byte ( (n &&& 0xFF)) st else - p_byte 0xFF st; + p_byte 0xFF st prim_p_int32 n st let space = () @@ -186,15 +188,22 @@ let p_space n () st = for i = 0 to n - 1 do p_byte 0 st +/// Represents space that was reserved but is now possibly used +let p_used_space1 f st = + p_byte 1 st + f st + // leave more space + p_space 1 space st + let p_bytes (s:byte[]) st = let len = s.Length - p_int32 (len) st; + p_int32 (len) st st.os.EmitBytes s let p_prim_string (s:string) st = let bytes = Encoding.UTF8.GetBytes s let len = bytes.Length - p_int32 (len) st; + p_int32 (len) st st.os.EmitBytes bytes let p_int c st = p_int32 c st @@ -204,7 +213,7 @@ let p_int16 (i:int16) st = p_int32 (int32 i) st let p_uint16 (x:uint16) st = p_int32 (int32 x) st let p_uint32 (x:uint32) st = p_int32 (int32 x) st let p_int64 (i:int64) st = - p_int32 (int32 (i &&& 0xFFFFFFFFL)) st; + p_int32 (int32 (i &&& 0xFFFFFFFFL)) st p_int32 (int32 (i >>> 32)) st let p_uint64 (x:uint64) st = p_int64 (int64 x) st @@ -256,7 +265,7 @@ let u_int32 st = let b1 = (u_byte st) (b0 <<< 8) ||| b1 else - assert(b0 = 0xFF); + assert(b0 = 0xFF) prim_u_int32 st let u_bytes st = @@ -290,8 +299,21 @@ let u_ieee64 st = float_of_bits (u_int64 st) let u_char st = char (int32 (u_uint16 st)) let u_space n st = for i = 0 to n - 1 do - u_byte st |> ignore + let b = u_byte st + if b <> 0 then + warning(Error(FSComp.SR.pickleUnexpectedNonZero st.ifile, range0)) +/// Represents space that was reserved but is now possibly used +let u_used_space1 f st = + let b = u_byte st + match b with + | 0 -> None + | 1 -> + let x = f st + u_space 1 st + Some x + | _ -> + warning(Error(FSComp.SR.pickleUnexpectedNonZero st.ifile, range0)); None let inline u_tup2 p1 p2 (st:ReaderState) = let a = p1 st in let b = p2 st in (a,b) @@ -376,19 +398,19 @@ let p_osgn_ref (_ctxt:string) (outMap : NodeOutTable<_,_>) x st = let p_osgn_decl (outMap : NodeOutTable<_,_>) p x st = let stamp = outMap.NodeStamp x let idx = outMap.Table.FindOrAdd stamp - //dprintf "decl %d#%d in table %s has name %s\n" idx (outMap.NodeStamp x) outMap.Name (outMap.NodeName x); + //dprintf "decl %d#%d in table %s has name %s\n" idx (outMap.NodeStamp x) outMap.Name (outMap.NodeName x) p_tup2 p_int p (idx,outMap.Deref x) st let u_osgn_ref (inMap: NodeInTable<_,_>) st = let n = u_int st - if n < 0 || n >= inMap.Count then ufailwith st ("u_osgn_ref: out of range, table = "+inMap.Name+", n = "+string n); + if n < 0 || n >= inMap.Count then ufailwith st ("u_osgn_ref: out of range, table = "+inMap.Name+", n = "+string n) inMap.Get n let u_osgn_decl (inMap: NodeInTable<_,_>) u st = let idx,data = u_tup2 u_int u st - // dprintf "unpickling osgn %d in table %s\n" idx nm; + // dprintf "unpickling osgn %d in table %s\n" idx nm let res = inMap.Get idx - inMap.LinkNode res data; + inMap.LinkNode res data res //--------------------------------------------------------------------------- @@ -398,7 +420,7 @@ let u_osgn_decl (inMap: NodeInTable<_,_>) u st = let encode_uniq (tbl: Table<_>) key = tbl.FindOrAdd key let lookup_uniq st tbl n = let arr = tbl.itbl_rows - if n < 0 || n >= arr.Length then ufailwith st ("lookup_uniq in table "+tbl.itbl_name+" out of range, n = "+string n+ ", sizeof(tab) = " + string (Array.length arr)); + if n < 0 || n >= arr.Length then ufailwith st ("lookup_uniq in table "+tbl.itbl_name+" out of range, n = "+string n+ ", sizeof(tab) = " + string (Array.length arr)) arr.[n] //--------------------------------------------------------------------------- @@ -406,13 +428,28 @@ let lookup_uniq st tbl n = // between internal representations relatively easily //------------------------------------------------------------------------- -let p_array f (x: 'T[]) st = - p_int x.Length st; +let p_array_core f (x: 'T[]) st = for i = 0 to x.Length-1 do f x.[i] st +let p_array f (x: 'T[]) st = + p_int x.Length st + p_array_core f x st + +// Optionally encode an extra item using a marker bit. +// When extraf is None, the marker bit is not set, and this is identical to p_array. +let p_array_ext extraf f (x: 'T[]) st = + let n = x.Length + let n = if Option.isSome extraf then n ||| 0x80000000 else n + p_int n st + match extraf with + | None -> () + | Some f -> f st + p_array_core f x st + let p_list f x st = p_array f (Array.ofList x) st +let p_list_ext extraf f x st = p_array_ext extraf f (Array.ofList x) st let p_List f (x: 'T list) st = p_list f x st @@ -428,37 +465,37 @@ let p_option f x st = let private p_lazy_impl p v st = let fixupPos1 = st.os.Position // We fix these up after - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos2 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos3 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos4 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos5 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos6 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let fixupPos7 = st.os.Position - prim_p_int32 0 st; + prim_p_int32 0 st let idx1 = st.os.Position let otyconsIdx1 = st.otycons.Size let otyparsIdx1 = st.otypars.Size let ovalsIdx1 = st.ovals.Size // Run the pickler - p v st; + p v st // Determine and fixup the length of the pickled data let idx2 = st.os.Position - st.os.FixupInt32 fixupPos1 (idx2-idx1); + st.os.FixupInt32 fixupPos1 (idx2-idx1) // Determine and fixup the ranges of OSGN nodes defined within the lazy portion let otyconsIdx2 = st.otycons.Size let otyparsIdx2 = st.otypars.Size let ovalsIdx2 = st.ovals.Size - st.os.FixupInt32 fixupPos2 otyconsIdx1; - st.os.FixupInt32 fixupPos3 otyconsIdx2; - st.os.FixupInt32 fixupPos4 otyparsIdx1; - st.os.FixupInt32 fixupPos5 otyparsIdx2; - st.os.FixupInt32 fixupPos6 ovalsIdx1; + st.os.FixupInt32 fixupPos2 otyconsIdx1 + st.os.FixupInt32 fixupPos3 otyconsIdx2 + st.os.FixupInt32 fixupPos4 otyparsIdx1 + st.os.FixupInt32 fixupPos5 otyparsIdx2 + st.os.FixupInt32 fixupPos6 ovalsIdx1 st.os.FixupInt32 fixupPos7 ovalsIdx2 let p_lazy p x st = @@ -471,14 +508,30 @@ let p_hole () = let h = ref (None : 'T pickler option) (fun f -> h := Some f),(fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") -let u_array f st = - let n = u_int st +let u_array_core f n st = let res = Array.zeroCreate n for i = 0 to n-1 do res.[i] <- f st res +let u_array f st = + let n = u_int st + u_array_core f n st + +// Optionally decode an extra item if a marker bit is present. +// When the marker bit is not set this is identical to u_array, and extraf is not called +let u_array_ext extraf f st = + let n = u_int st + let extraItem = + if n &&& 0x80000000 = 0x80000000 then + Some (extraf st) + else + None + let arr = u_array_core f (n &&& 0x7FFFFFFF) st + extraItem, arr + let u_list f st = Array.toList (u_array f st) +let u_list_ext extra f st = let v, res = u_array_ext extra f st in v, Array.toList res #if FLAT_LIST_AS_LIST #else @@ -535,16 +588,16 @@ let u_lazy u st = // Record the position in the bytestream to use when forcing the read of the data let idx1 = st.is.Position // Skip the length of data - st.is.Skip len; + st.is.Skip len // This is the lazy computation that wil force the unpickling of the term. // This term must contain OSGN definitions of the given nodes. let res = lazy (let st = { st with is = st.is.CloneAndSeek idx1 } u st) /// Force the reading of the data as a "tripwire" for each of the OSGN thunks - for i = otyconsIdx1 to otyconsIdx2-1 do wire (st.itycons.Get(i)) res done; - for i = ovalsIdx1 to ovalsIdx2-1 do wire (st.ivals.Get(i)) res done; - for i = otyparsIdx1 to otyparsIdx2-1 do wire (st.itypars.Get(i)) res done; + for i = otyconsIdx1 to otyconsIdx2-1 do wire (st.itycons.Get(i)) res done + for i = ovalsIdx1 to ovalsIdx2-1 do wire (st.ivals.Get(i)) res done + for i = otyparsIdx1 to otyparsIdx2-1 do wire (st.itypars.Get(i)) res done res #else ignore (len, otyconsIdx1, otyconsIdx2, otyparsIdx1, otyparsIdx2, ovalsIdx1, ovalsIdx2) @@ -641,23 +694,23 @@ let p_encoded_simpletyp x st = p_int x st let p_simpletyp x st = p_int (encode_simpletyp st.occus st.ostrings st.onlerefs st.osimpletyps st.oscope x) st type sizes = int * int * int -let pickleObjWithDanglingCcus file g scope p x = +let pickleObjWithDanglingCcus inMem file g scope p x = let ccuNameTab,(sizes: sizes),stringTab,pubpathTab,nlerefTab,simpletypTab,phase1bytes = let st1 = - { os = ByteBuffer.Create 100000; - oscope=scope; - occus= Table<_>.Create "occus"; - otycons=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons"); - otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars"); - ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals"); - ostrings=Table<_>.Create "ostrings"; - onlerefs=Table<_>.Create "onlerefs"; - opubpaths=Table<_>.Create "opubpaths"; - osimpletyps=Table<_>.Create "osimpletyps"; - oglobals=g; - ofile=file; - (* REINSTATE: odecomps=NodeOutTable.Create stamp_of_decomp name_of_decomp "odecomps"; *) } - p x st1; + { os = ByteBuffer.Create 100000 + oscope=scope + occus= Table<_>.Create "occus" + otycons=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons") + otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars") + ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals") + ostrings=Table<_>.Create "ostrings" + onlerefs=Table<_>.Create "onlerefs" + opubpaths=Table<_>.Create "opubpaths" + osimpletyps=Table<_>.Create "osimpletyps" + oglobals=g + ofile=file + oInMem=inMem } + p x st1 let sizes = st1.otycons.Size, st1.otypars.Size, @@ -666,18 +719,19 @@ let pickleObjWithDanglingCcus file g scope p x = let phase2data = (ccuNameTab.AsArray,sizes,stringTab.AsArray,pubpathTab.AsArray,nlerefTab.AsArray,simpletypTab.AsArray,phase1bytes) let phase2bytes = let st2 = - { os = ByteBuffer.Create 100000; - oscope=scope; - occus= Table<_>.Create "occus (fake)"; - otycons=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons"); - otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars"); - ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals"); - ostrings=Table<_>.Create "ostrings (fake)"; - opubpaths=Table<_>.Create "opubpaths (fake)"; - onlerefs=Table<_>.Create "onlerefs (fake)"; - osimpletyps=Table<_>.Create "osimpletyps (fake)"; - oglobals=g; - ofile=file; } + { os = ByteBuffer.Create 100000 + oscope=scope + occus= Table<_>.Create "occus (fake)" + otycons=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons") + otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars") + ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals") + ostrings=Table<_>.Create "ostrings (fake)" + opubpaths=Table<_>.Create "opubpaths (fake)" + onlerefs=Table<_>.Create "onlerefs (fake)" + osimpletyps=Table<_>.Create "osimpletyps (fake)" + oglobals=g + ofile=file + oInMem=inMem } p_tup7 (p_array p_encoded_ccuref) (p_tup3 p_int p_int p_int) @@ -686,7 +740,7 @@ let pickleObjWithDanglingCcus file g scope p x = (p_array p_encoded_nleref) (p_array p_encoded_simpletyp) p_bytes - phase2data st2; + phase2data st2 st2.os.Close() phase2bytes @@ -699,16 +753,16 @@ let check (ilscope:ILScopeRef) (inMap : NodeInTable<_,_>) = let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (phase2bytes:byte[]) = let st2 = - { is = ByteStream.FromBytes (phase2bytes,0,phase2bytes.Length); - iilscope= ilscope; - iccus= new_itbl "iccus (fake)" [| |]; - itycons= NodeInTable<_,_>.Create (Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",0); - itypars= NodeInTable<_,_>.Create (Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",0); - ivals = NodeInTable<_,_>.Create (Val.NewUnlinked , (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",0); - istrings = new_itbl "istrings (fake)" [| |]; - inlerefs = new_itbl "inlerefs (fake)" [| |]; - ipubpaths = new_itbl "ipubpaths (fake)" [| |]; - isimpletyps = new_itbl "isimpletyps (fake)" [| |]; + { is = ByteStream.FromBytes (phase2bytes,0,phase2bytes.Length) + iilscope= ilscope + iccus= new_itbl "iccus (fake)" [| |] + itycons= NodeInTable<_,_>.Create (Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",0) + itypars= NodeInTable<_,_>.Create (Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",0) + ivals = NodeInTable<_,_>.Create (Val.NewUnlinked , (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",0) + istrings = new_itbl "istrings (fake)" [| |] + inlerefs = new_itbl "inlerefs (fake)" [| |] + ipubpaths = new_itbl "ipubpaths (fake)" [| |] + isimpletyps = new_itbl "isimpletyps (fake)" [| |] ifile=file iILModule = iILModule } let phase2data = @@ -729,24 +783,24 @@ let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (p let ((ntycons,ntypars,nvals) : sizes) = sizes let data = let st1 = - { is = ByteStream.FromBytes (phase1bytes,0,phase1bytes.Length); - iccus= ccuTab; - iilscope= ilscope; - itycons= NodeInTable<_,_>.Create(Tycon.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",ntycons); - itypars= NodeInTable<_,_>.Create(Typar.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",ntypars); - ivals= NodeInTable<_,_>.Create(Val.NewUnlinked ,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",nvals); - istrings = stringTab; - ipubpaths = pubpathTab; - inlerefs = nlerefTab; - isimpletyps = simpletypTab; + { is = ByteStream.FromBytes (phase1bytes,0,phase1bytes.Length) + iccus= ccuTab + iilscope= ilscope + itycons= NodeInTable<_,_>.Create(Tycon.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",ntycons) + itypars= NodeInTable<_,_>.Create(Typar.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",ntypars) + ivals= NodeInTable<_,_>.Create(Val.NewUnlinked ,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",nvals) + istrings = stringTab + ipubpaths = pubpathTab + inlerefs = nlerefTab + isimpletyps = simpletypTab ifile=file iILModule = iILModule } let res = u st1 #if LAZY_UNPICKLE #else - check ilscope st1.itycons; - check ilscope st1.ivals; - check ilscope st1.itypars; + check ilscope st1.itycons + check ilscope st1.ivals + check ilscope st1.itypars #endif res @@ -831,8 +885,8 @@ let rec p_ILType ty st = | ILType.Boxed tspec -> p_byte 3 st; p_ILTypeSpec tspec st | ILType.Ptr ty -> p_byte 4 st; p_ILType ty st | ILType.Byref ty -> p_byte 5 st; p_ILType ty st - | ILType.FunctionPointer csig -> p_byte 6 st; p_ILCallSig csig st - | ILType.TypeVar n -> p_byte 7 st; p_uint16 n st + | ILType.FunctionPointer csig -> p_byte 6 st; p_ILCallSig csig st + | ILType.TypeVar n -> p_byte 7 st; p_uint16 n st | ILType.Modified (req,tref,ty) -> p_byte 8 st; p_tup3 p_bool p_ILTypeRef p_ILType (req,tref,ty) st and p_ILTypes tys = p_list p_ILType tys @@ -1028,42 +1082,42 @@ let [] itag_cpobj = 65 // currently unused, added for forward let [] itag_cpblk = 66 // currently unused, added for forward compat let simple_instrs = - [ itag_add, AI_add; - itag_add_ovf, AI_add_ovf; - itag_add_ovf_un, AI_add_ovf_un; - itag_and, AI_and; - itag_div, AI_div; - itag_div_un, AI_div_un; - itag_ceq, AI_ceq; - itag_cgt, AI_cgt ; - itag_cgt_un, AI_cgt_un; - itag_clt, AI_clt; - itag_clt_un, AI_clt_un; - itag_mul, AI_mul ; - itag_mul_ovf, AI_mul_ovf; - itag_mul_ovf_un, AI_mul_ovf_un; - itag_rem, AI_rem ; - itag_rem_un, AI_rem_un ; - itag_shl, AI_shl ; - itag_shr, AI_shr ; - itag_shr_un, AI_shr_un; - itag_sub, AI_sub ; - itag_sub_ovf, AI_sub_ovf; - itag_sub_ovf_un, AI_sub_ovf_un; - itag_xor, AI_xor; - itag_or, AI_or; - itag_neg, AI_neg; - itag_not, AI_not; - itag_ldnull, AI_ldnull; - itag_ckfinite, AI_ckfinite; - itag_nop, AI_nop; - itag_localloc, I_localloc; - itag_throw, I_throw; - itag_ldlen, I_ldlen; - itag_rethrow, I_rethrow; - itag_rethrow, I_rethrow; - itag_initblk, I_initblk (Aligned,Nonvolatile); - itag_cpblk, I_cpblk (Aligned,Nonvolatile); + [ itag_add, AI_add + itag_add_ovf, AI_add_ovf + itag_add_ovf_un, AI_add_ovf_un + itag_and, AI_and + itag_div, AI_div + itag_div_un, AI_div_un + itag_ceq, AI_ceq + itag_cgt, AI_cgt + itag_cgt_un, AI_cgt_un + itag_clt, AI_clt + itag_clt_un, AI_clt_un + itag_mul, AI_mul + itag_mul_ovf, AI_mul_ovf + itag_mul_ovf_un, AI_mul_ovf_un + itag_rem, AI_rem + itag_rem_un, AI_rem_un + itag_shl, AI_shl + itag_shr, AI_shr + itag_shr_un, AI_shr_un + itag_sub, AI_sub + itag_sub_ovf, AI_sub_ovf + itag_sub_ovf_un, AI_sub_ovf_un + itag_xor, AI_xor + itag_or, AI_or + itag_neg, AI_neg + itag_not, AI_not + itag_ldnull, AI_ldnull + itag_ckfinite, AI_ckfinite + itag_nop, AI_nop + itag_localloc, I_localloc + itag_throw, I_throw + itag_ldlen, I_ldlen + itag_rethrow, I_rethrow + itag_rethrow, I_rethrow + itag_initblk, I_initblk (Aligned,Nonvolatile) + itag_cpblk, I_cpblk (Aligned,Nonvolatile) ] let encode_table = Dictionary<_,_>(300, HashIdentity.Structural) @@ -1072,66 +1126,64 @@ let encode_instr si = encode_table.[si] let isNoArgInstr s = encode_table.ContainsKey s let decoders = - [ itag_ldarg, u_uint16 >> mkLdarg; - itag_call, u_ILMethodSpec >> (fun a -> I_call (Normalcall,a,None)); - itag_callvirt, u_ILMethodSpec >> (fun a -> I_callvirt (Normalcall,a,None)); - itag_ldvirtftn, u_ILMethodSpec >> I_ldvirtftn; - itag_conv, u_ILBasicType >> (fun a -> (AI_conv a)); - itag_conv_ovf, u_ILBasicType >> (fun a -> (AI_conv_ovf a)); - itag_conv_ovf_un, u_ILBasicType >> (fun a -> (AI_conv_ovf_un a)); - itag_ldfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_ldfld (Aligned,b,c)); - itag_ldflda, u_ILFieldSpec >> I_ldflda; - itag_ldsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_ldsfld (a,b)); - itag_ldsflda, u_ILFieldSpec >> I_ldsflda; - itag_stfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_stfld (Aligned,b,c)); - itag_stsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_stsfld (a,b)); - itag_ldtoken, u_ILType >> (fun a -> I_ldtoken (ILToken.ILType a)); - itag_ldstr, u_string >> I_ldstr; - itag_box, u_ILType >> I_box; - itag_unbox, u_ILType >> I_unbox; - itag_unbox_any, u_ILType >> I_unbox_any; - itag_newarr, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_newarr(a,b)); - itag_stelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_stelem_any(a,b)); - itag_ldelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_ldelem_any(a,b)); - itag_ldelema, u_tup3 u_ILReadonly u_ILArrayShape u_ILType >> (fun (a,b,c) -> I_ldelema(a,false,b,c)); - itag_castclass, u_ILType >> I_castclass; - itag_isinst, u_ILType >> I_isinst; - itag_ldobj, u_ILType >> (fun c -> I_ldobj (Aligned,Nonvolatile,c)); - itag_stobj, u_ILType >> (fun c -> I_stobj (Aligned,Nonvolatile,c)); - itag_sizeof, u_ILType >> I_sizeof; - itag_ldlen_multi, u_tup2 u_int32 u_int32 >> (fun (a,b) -> EI_ldlen_multi (a,b)); - itag_ilzero, u_ILType >> EI_ilzero; - itag_ilzero, u_ILType >> EI_ilzero; - itag_initobj, u_ILType >> I_initobj; - itag_cpobj, u_ILType >> I_cpobj; + [ itag_ldarg, u_uint16 >> mkLdarg + itag_call, u_ILMethodSpec >> (fun a -> I_call (Normalcall,a,None)) + itag_callvirt, u_ILMethodSpec >> (fun a -> I_callvirt (Normalcall,a,None)) + itag_ldvirtftn, u_ILMethodSpec >> I_ldvirtftn + itag_conv, u_ILBasicType >> (fun a -> (AI_conv a)) + itag_conv_ovf, u_ILBasicType >> (fun a -> (AI_conv_ovf a)) + itag_conv_ovf_un, u_ILBasicType >> (fun a -> (AI_conv_ovf_un a)) + itag_ldfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_ldfld (Aligned,b,c)) + itag_ldflda, u_ILFieldSpec >> I_ldflda + itag_ldsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_ldsfld (a,b)) + itag_ldsflda, u_ILFieldSpec >> I_ldsflda + itag_stfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_stfld (Aligned,b,c)) + itag_stsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_stsfld (a,b)) + itag_ldtoken, u_ILType >> (fun a -> I_ldtoken (ILToken.ILType a)) + itag_ldstr, u_string >> I_ldstr + itag_box, u_ILType >> I_box + itag_unbox, u_ILType >> I_unbox + itag_unbox_any, u_ILType >> I_unbox_any + itag_newarr, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_newarr(a,b)) + itag_stelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_stelem_any(a,b)) + itag_ldelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_ldelem_any(a,b)) + itag_ldelema, u_tup3 u_ILReadonly u_ILArrayShape u_ILType >> (fun (a,b,c) -> I_ldelema(a,false,b,c)) + itag_castclass, u_ILType >> I_castclass + itag_isinst, u_ILType >> I_isinst + itag_ldobj, u_ILType >> (fun c -> I_ldobj (Aligned,Nonvolatile,c)) + itag_stobj, u_ILType >> (fun c -> I_stobj (Aligned,Nonvolatile,c)) + itag_sizeof, u_ILType >> I_sizeof + itag_ldlen_multi, u_tup2 u_int32 u_int32 >> (fun (a,b) -> EI_ldlen_multi (a,b)) + itag_ilzero, u_ILType >> EI_ilzero + itag_ilzero, u_ILType >> EI_ilzero + itag_initobj, u_ILType >> I_initobj + itag_cpobj, u_ILType >> I_cpobj ] let decode_tab = let tab = Array.init 256 (fun n -> (fun st -> ufailwith st ("no decoder for instruction "+string n))) let add_instr (icode,f) = tab.[icode] <- f - List.iter add_instr decoders; - List.iter (fun (icode,mk) -> add_instr (icode,(fun _ -> mk))) simple_instrs; + List.iter add_instr decoders + List.iter (fun (icode,mk) -> add_instr (icode,(fun _ -> mk))) simple_instrs tab let p_ILInstr x st = match x with - | si when isNoArgInstr si -> p_byte (encode_instr si) st - | I_call (Normalcall,mspec,None) - -> p_byte itag_call st; p_ILMethodSpec mspec st; - | I_callvirt (Normalcall,mspec,None) - -> p_byte itag_callvirt st; p_ILMethodSpec mspec st; - | I_ldvirtftn mspec -> p_byte itag_ldvirtftn st; p_ILMethodSpec mspec st; + | si when isNoArgInstr si -> p_byte (encode_instr si) st + | I_call(Normalcall,mspec,None) -> p_byte itag_call st; p_ILMethodSpec mspec st + | I_callvirt(Normalcall,mspec,None) -> p_byte itag_callvirt st; p_ILMethodSpec mspec st + | I_ldvirtftn mspec -> p_byte itag_ldvirtftn st; p_ILMethodSpec mspec st | I_ldarg x -> p_byte itag_ldarg st; p_uint16 x st - | (AI_conv a) -> p_byte itag_conv st; p_ILBasicType a st - | (AI_conv_ovf a) -> p_byte itag_conv_ovf st; p_ILBasicType a st - | (AI_conv_ovf_un a) -> p_byte itag_conv_ovf_un st; p_ILBasicType a st + | AI_conv a -> p_byte itag_conv st; p_ILBasicType a st + | AI_conv_ovf a -> p_byte itag_conv_ovf st; p_ILBasicType a st + | AI_conv_ovf_un a -> p_byte itag_conv_ovf_un st; p_ILBasicType a st | I_ldfld (Aligned,b,c) -> p_byte itag_ldfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b,c) st | I_ldsfld (a,b) -> p_byte itag_ldsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a,b) st | I_stfld (Aligned,b,c) -> p_byte itag_stfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b,c) st | I_stsfld (a,b) -> p_byte itag_stsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a,b) st | I_ldflda c -> p_byte itag_ldflda st; p_ILFieldSpec c st | I_ldsflda a -> p_byte itag_ldsflda st; p_ILFieldSpec a st - | I_ldtoken (ILToken.ILType ty) -> p_byte itag_ldtoken st; p_ILType ty st + | I_ldtoken (ILToken.ILType ty) -> p_byte itag_ldtoken st; p_ILType ty st | I_ldstr s -> p_byte itag_ldstr st; p_string s st | I_box ty -> p_byte itag_box st; p_ILType ty st | I_unbox ty -> p_byte itag_unbox st; p_ILType ty st @@ -1139,7 +1191,7 @@ let p_ILInstr x st = | I_newarr (a,b) -> p_byte itag_newarr st; p_tup2 p_ILArrayShape p_ILType (a,b) st | I_stelem_any (a,b) -> p_byte itag_stelem_any st; p_tup2 p_ILArrayShape p_ILType (a,b) st | I_ldelem_any (a,b) -> p_byte itag_ldelem_any st; p_tup2 p_ILArrayShape p_ILType (a,b) st - | I_ldelema (a,_,b,c) -> p_byte itag_ldelema st; p_tup3 p_ILReadonly p_ILArrayShape p_ILType (a,b,c) st + | I_ldelema (a,_,b,c) -> p_byte itag_ldelema st; p_tup3 p_ILReadonly p_ILArrayShape p_ILType (a,b,c) st | I_castclass ty -> p_byte itag_castclass st; p_ILType ty st | I_isinst ty -> p_byte itag_isinst st; p_ILType ty st | I_ldobj (Aligned,Nonvolatile,c) -> p_byte itag_ldobj st; p_ILType c st @@ -1161,12 +1213,10 @@ let u_ILInstr st = // Pickle/unpickle for F# types and module signatures //--------------------------------------------------------------------------- -// TODO: remove all pickling of maps let p_Map pk pv = p_wrap Map.toList (p_list (p_tup2 pk pv)) let p_qlist pv = p_wrap QueueList.toList (p_list pv) let p_namemap p = p_Map p_string p -// TODO: remove all pickling of maps let u_Map uk uv = u_wrap Map.ofList (u_list (u_tup2 uk uv)) let u_qlist uv = u_wrap QueueList.ofList (u_list uv) let u_namemap u = u_Map u_string u @@ -1224,9 +1274,9 @@ let p_nonlocal_val_ref (nlv:NonLocalValOrMemberRef) st = let pkey = key.PartialKey p_tcref "nlvref" a st p_option p_string pkey.MemberParentMangledName st - p_bool pkey.MemberIsOverride st; - p_string pkey.LogicalName st; - p_int pkey.TotalArgCount st; + p_bool pkey.MemberIsOverride st + p_string pkey.LogicalName st + p_int pkey.TotalArgCount st p_option p_typ key.TypeForLinkage st let rec p_vref ctxt x st = @@ -1298,10 +1348,10 @@ let p_MemberFlags x st = x.MemberKind) st let u_MemberFlags st = let x2,_x3UnusedBoolInFormat,x4,x5,x6,x7 = u_tup6 u_bool u_bool u_bool u_bool u_bool u_member_kind st - { IsInstance=x2; - IsDispatchSlot=x4; - IsOverrideOrExplicitImpl=x5; - IsFinal=x6; + { IsInstance=x2 + IsDispatchSlot=x4 + IsOverrideOrExplicitImpl=x5 + IsFinal=x6 MemberKind=x7} let fill_u_Expr_hole,u_expr_fwd = u_hole() @@ -1416,19 +1466,19 @@ let rec u_measure_expr st = let p_typar_constraint x st = match x with - | TyparConstraint.CoercesTo (a,_) -> p_byte 0 st; p_typ a st + | TyparConstraint.CoercesTo (a,_) -> p_byte 0 st; p_typ a st | TyparConstraint.MayResolveMember(traitInfo,_) -> p_byte 1 st; p_trait traitInfo st - | TyparConstraint.DefaultsTo(_,rty,_) -> p_byte 2 st; p_typ rty st - | TyparConstraint.SupportsNull _ -> p_byte 3 st - | TyparConstraint.IsNonNullableStruct _ -> p_byte 4 st - | TyparConstraint.IsReferenceType _ -> p_byte 5 st - | TyparConstraint.RequiresDefaultConstructor _ -> p_byte 6 st - | TyparConstraint.SimpleChoice(tys,_) -> p_byte 7 st; p_typs tys st - | TyparConstraint.IsEnum(ty,_) -> p_byte 8 st; p_typ ty st - | TyparConstraint.IsDelegate(aty,bty,_) -> p_byte 9 st; p_typ aty st; p_typ bty st - | TyparConstraint.SupportsComparison _ -> p_byte 10 st - | TyparConstraint.SupportsEquality _ -> p_byte 11 st - | TyparConstraint.IsUnmanaged _ -> p_byte 12 st + | TyparConstraint.DefaultsTo(_,rty,_) -> p_byte 2 st; p_typ rty st + | TyparConstraint.SupportsNull _ -> p_byte 3 st + | TyparConstraint.IsNonNullableStruct _ -> p_byte 4 st + | TyparConstraint.IsReferenceType _ -> p_byte 5 st + | TyparConstraint.RequiresDefaultConstructor _ -> p_byte 6 st + | TyparConstraint.SimpleChoice(tys,_) -> p_byte 7 st; p_typs tys st + | TyparConstraint.IsEnum(ty,_) -> p_byte 8 st; p_typ ty st + | TyparConstraint.IsDelegate(aty,bty,_) -> p_byte 9 st; p_typ aty st; p_typ bty st + | TyparConstraint.SupportsComparison _ -> p_byte 10 st + | TyparConstraint.SupportsEquality _ -> p_byte 11 st + | TyparConstraint.IsUnmanaged _ -> p_byte 12 st let p_typar_constraints = (p_list p_typar_constraint) let u_typar_constraint st = @@ -1464,22 +1514,22 @@ let p_typar_spec_data (x:Typar) st = (x.typar_id,x.typar_attribs,int64 x.typar_flags.PickledBits,x.typar_constraints,x.typar_xmldoc) st let p_typar_spec (x:Typar) st = - //Disabled, workaround for bug 2721: if x.Rigidity <> TyparRigidity.Rigid then warning(Error(sprintf "p_typar_spec: typar#%d is not rigid" x.Stamp, x.Range)); - if x.IsFromError then warning(Error((0,"p_typar_spec: from error"), x.Range)); + //Disabled, workaround for bug 2721: if x.Rigidity <> TyparRigidity.Rigid then warning(Error(sprintf "p_typar_spec: typar#%d is not rigid" x.Stamp, x.Range)) + if x.IsFromError then warning(Error((0,"p_typar_spec: from error"), x.Range)) p_osgn_decl st.otypars p_typar_spec_data x st let p_typar_specs = (p_list p_typar_spec) let u_typar_spec_data st = let a,c,d,e,g = u_tup5 u_ident u_attribs u_int64 u_typar_constraints u_xmldoc st - { typar_id=a; - typar_il_name=None; - typar_stamp=newStamp(); - typar_attribs=c; - typar_flags=TyparFlags(int32 d); - typar_constraints=e; - typar_solution=None; - typar_xmldoc=g; + { typar_id=a + typar_il_name=None + typar_stamp=newStamp() + typar_attribs=c + typar_flags=TyparFlags(int32 d) + typar_constraints=e + typar_solution=None + typar_xmldoc=g typar_astype= Unchecked.defaultof<_> } let u_typar_spec st = @@ -1495,13 +1545,13 @@ let _ = fill_p_typ (fun ty st -> p_byte 8 st; p_typs l st else p_byte 0 st; p_typs l st - | TType_app(ERefNonLocal nleref,[]) -> p_byte 1 st; p_simpletyp nleref st - | TType_app (tc,tinst) -> p_byte 2 st; p_tup2 (p_tcref "typ") p_typs (tc,tinst) st - | TType_fun (d,r) -> p_byte 3 st; p_tup2 p_typ p_typ (d,r) st - | TType_var r -> p_byte 4 st; p_tpref r st - | TType_forall (tps,r) -> p_byte 5 st; p_tup2 p_typar_specs p_typ (tps,r) st - | TType_measure unt -> p_byte 6 st; p_measure_expr unt st - | TType_ucase (uc,tinst) -> p_byte 7 st; p_tup2 p_ucref p_typs (uc,tinst) st) + | TType_app(ERefNonLocal nleref,[]) -> p_byte 1 st; p_simpletyp nleref st + | TType_app (tc,tinst) -> p_byte 2 st; p_tup2 (p_tcref "typ") p_typs (tc,tinst) st + | TType_fun (d,r) -> p_byte 3 st; p_tup2 p_typ p_typ (d,r) st + | TType_var r -> p_byte 4 st; p_tpref r st + | TType_forall (tps,r) -> p_byte 5 st; p_tup2 p_typar_specs p_typ (tps,r) st + | TType_measure unt -> p_byte 6 st; p_measure_expr unt st + | TType_ucase (uc,tinst) -> p_byte 7 st; p_tup2 p_ucref p_typs (uc,tinst) st) let _ = fill_u_typ (fun st -> let tag = u_byte st @@ -1531,16 +1581,16 @@ let fill_u_constraints,u_constraints = u_hole() let fill_u_Vals,u_Vals = u_hole() let p_ArgReprInfo (x:ArgReprInfo) st = - p_attribs x.Attribs st; + p_attribs x.Attribs st p_option p_ident x.Name st let p_TyparReprInfo (TyparReprInfo(a,b)) st = - p_ident a st; + p_ident a st p_kind b st let p_ValReprInfo (ValReprInfo (a,args,ret)) st = - p_list p_TyparReprInfo a st; - p_list (p_list p_ArgReprInfo) args st; + p_list p_TyparReprInfo a st + p_list (p_list p_ArgReprInfo) args st p_ArgReprInfo ret st let u_ArgReprInfo st = @@ -1590,12 +1640,12 @@ let rec dummy x = x and p_tycon_repr x st = // The leading "p_byte 1" and "p_byte 0" come from the F# 2.0 format, which used an option value at this point. match x with - | TRecdRepr fs -> p_byte 1 st; p_byte 0 st; p_rfield_table fs st; false - | TUnionRepr x -> p_byte 1 st; p_byte 1 st; p_list p_unioncase_spec (Array.toList x.CasesTable.CasesByIndex) st; false - | TAsmRepr ilty -> p_byte 1 st; p_byte 2 st; p_ILType ilty st; false - | TFSharpObjectRepr r -> p_byte 1 st; p_byte 3 st; p_tycon_objmodel_data r st; false - | TMeasureableRepr ty -> p_byte 1 st; p_byte 4 st; p_typ ty st; false - | TNoRepr -> p_byte 0 st; false + | TRecdRepr fs -> p_byte 1 st; p_byte 0 st; p_rfield_table fs st; false + | TUnionRepr x -> p_byte 1 st; p_byte 1 st; p_list p_unioncase_spec (Array.toList x.CasesTable.CasesByIndex) st; false + | TAsmRepr ilty -> p_byte 1 st; p_byte 2 st; p_ILType ilty st; false + | TFSharpObjectRepr r -> p_byte 1 st; p_byte 3 st; p_tycon_objmodel_data r st; false + | TMeasureableRepr ty -> p_byte 1 st; p_byte 4 st; p_typ ty st; false + | TNoRepr -> p_byte 0 st; false #if EXTENSIONTYPING | TProvidedTypeExtensionPoint info -> if info.IsErased then @@ -1612,10 +1662,17 @@ and p_tycon_objmodel_data x st = p_tup3 p_tycon_objmodel_kind (p_vrefs "vslots") p_rfield_table (x.fsobjmodel_kind, x.fsobjmodel_vslots, x.fsobjmodel_rfields) st +and p_attribs_ext f x st = p_list_ext f p_attrib x st + and p_unioncase_spec x st = - p_tup7 - p_rfield_table p_typ p_string p_ident p_attribs p_string p_access - (x.FieldTable,x.ReturnType,x.CompiledName,x.Id,x.Attribs,x.XmlDocSig,x.Accessibility) st + p_rfield_table x.FieldTable st + p_typ x.ReturnType st + p_string x.CompiledName st + p_ident x.Id st + // The XmlDoc are only written for the extended in-memory format. We encode their presence using a marker bit here + p_attribs_ext (if st.oInMem then Some (p_xmldoc x.XmlDoc) else None) x.Attribs st + p_string x.XmlDocSig st + p_access x.Accessibility st and p_exnc_spec_data x st = p_entity_spec_data x st @@ -1631,32 +1688,44 @@ and p_exnc_spec x st = p_tycon_spec x st and p_access (TAccess n) st = p_list p_cpath n st and p_recdfield_spec x st = - p_tup11 - p_bool p_bool p_typ p_bool p_bool (p_option p_const) p_ident p_attribs p_attribs p_string p_access - (x.rfield_mutable,x.rfield_volatile,x.rfield_type,x.rfield_static,x.rfield_secret,x.rfield_const,x.rfield_id,x.rfield_pattribs,x.rfield_fattribs,x.rfield_xmldocsig,x.rfield_access) st + p_bool x.rfield_mutable st + p_bool x.rfield_volatile st + p_typ x.rfield_type st + p_bool x.rfield_static st + p_bool x.rfield_secret st + p_option p_const x.rfield_const st + p_ident x.rfield_id st + p_attribs_ext (if st.oInMem then Some (p_xmldoc x.XmlDoc) else None) x.rfield_pattribs st + p_attribs x.rfield_fattribs st + p_string x.rfield_xmldocsig st + p_access x.rfield_access st and p_rfield_table x st = p_list p_recdfield_spec (Array.toList x.FieldsByIndex) st and p_entity_spec_data (x:Entity) st = - p_typar_specs (x.entity_typars.Force(x.entity_range)) st - p_string x.entity_logical_name st - p_option p_string x.entity_compiled_name st - p_range x.entity_range st - p_option p_pubpath x.entity_pubpath st - p_access x.entity_accessiblity st - p_access x.entity_tycon_repr_accessibility st - p_attribs x.entity_attribs st - let flagBit = p_tycon_repr x.entity_tycon_repr st - p_option p_typ x.entity_tycon_abbrev st - p_tcaug x.entity_tycon_tcaug st - p_string x.entity_xmldocsig st - p_kind x.entity_kind st - p_int64 (x.entity_flags.PickledBits ||| (if flagBit then EntityFlags.ReservedBitForPickleFormatTyconReprFlag else 0L)) st - p_option p_cpath x.entity_cpath st - p_maybe_lazy p_modul_typ x.entity_modul_contents st - p_exnc_repr x.entity_exn_info st - p_space 1 space st + p_typar_specs (x.entity_typars.Force(x.entity_range)) st + p_string x.entity_logical_name st + p_option p_string x.entity_compiled_name st + p_range x.entity_range st + p_option p_pubpath x.entity_pubpath st + p_access x.entity_accessiblity st + p_access x.entity_tycon_repr_accessibility st + p_attribs x.entity_attribs st + let flagBit = p_tycon_repr x.entity_tycon_repr st + p_option p_typ x.entity_tycon_abbrev st + p_tcaug x.entity_tycon_tcaug st + p_string x.entity_xmldocsig st + p_kind x.entity_kind st + p_int64 (x.entity_flags.PickledBits ||| (if flagBit then EntityFlags.ReservedBitForPickleFormatTyconReprFlag else 0L)) st + p_option p_cpath x.entity_cpath st + p_maybe_lazy p_modul_typ x.entity_modul_contents st + p_exnc_repr x.entity_exn_info st + if st.oInMem then + p_used_space1 (p_xmldoc x.entity_xmldoc) st + else + p_space 1 () st + and p_tcaug p st = p_tup9 @@ -1742,35 +1811,23 @@ and p_vrefFlags x st = | VSlotDirectCall -> p_byte 4 st and p_ValData x st = - //if verbose then dprintf "p_ValData, nm = %s, stamp #%d, ty = %s\n" x.val_name x.val_stamp (DebugPrint.showType x.val_type); - p_tup13 - p_string - (p_option p_string) - p_ranges - p_typ - p_int64 - (p_option p_member_info) - p_attribs - (p_option p_ValReprInfo) - p_string - p_access - p_parentref - (p_option p_const) - (p_space 1) - ( x.val_logical_name, - x.val_compiled_name, - // only keep range information on published values, not on optimization data - (if x.val_repr_info.IsSome then Some(x.val_range, x.DefinitionRange) else None), - x.val_type, - x.val_flags.PickledBits, - x.val_member_info, - x.val_attribs, - x.val_repr_info, - x.val_xmldocsig, - x.val_access, - x.val_actual_parent, - x.val_const, - space) st + p_string x.val_logical_name st + p_option p_string x.val_compiled_name st + // only keep range information on published values, not on optimization data + p_ranges (if x.val_repr_info.IsSome then Some(x.val_range, x.DefinitionRange) else None) st + p_typ x.val_type st + p_int64 x.val_flags.PickledBits st + p_option p_member_info x.val_member_info st + p_attribs x.val_attribs st + p_option p_ValReprInfo x.val_repr_info st + p_string x.val_xmldocsig st + p_access x.val_access st + p_parentref x.val_actual_parent st + p_option p_const x.val_const st + if st.oInMem then + p_used_space1 (p_xmldoc x.val_xmldoc) st + else + p_space 1 () st and p_Val x st = p_osgn_decl st.ovals p_ValData x st @@ -1833,16 +1890,25 @@ and u_tycon_objmodel_data st = let x1,x2,x3 = u_tup3 u_tycon_objmodel_kind u_vrefs u_rfield_table st {fsobjmodel_kind=x1; fsobjmodel_vslots=x2; fsobjmodel_rfields=x3 } +and u_attribs_ext extraf st = u_list_ext extraf u_attrib st and u_unioncase_spec st = - let a,b,c,d,e,f,i = u_tup7 u_rfield_table u_typ u_string u_ident u_attribs u_string u_access st - {FieldTable=a; - ReturnType=b; - CompiledName=c; - Id=d; - Attribs=e; - XmlDoc=XmlDoc.Empty; - XmlDocSig=f;Accessibility=i; - OtherRangeOpt=None } + let a = u_rfield_table st + let b = u_typ st + let c = u_string st + let d = u_ident st + // The XmlDoc is only present in the extended in-memory format. We detect its presence using a marker bit here + let xmldoc, e = u_attribs_ext u_xmldoc st + let f = u_string st + let i = u_access st + { FieldTable=a + ReturnType=b + CompiledName=c + Id=d + Attribs=e + XmlDoc= defaultArg xmldoc XmlDoc.Empty + XmlDocSig=f + Accessibility=i + OtherRangeOpt=None } and u_exnc_spec_data st = u_entity_spec_data st @@ -1863,38 +1929,36 @@ and u_access st = | res -> TAccess res and u_recdfield_spec st = - let a,b,c1,c2,c2b,c3,d,e1,e2,f,g = - u_tup11 - u_bool - u_bool - u_typ - u_bool - u_bool - (u_option u_const) - u_ident - u_attribs - u_attribs - u_string - u_access - st - { rfield_mutable=a; - rfield_volatile=b; - rfield_type=c1; - rfield_static=c2; - rfield_secret=c2b; - rfield_const=c3; - rfield_id=d; - rfield_pattribs=e1; - rfield_fattribs=e2; - rfield_xmldoc=XmlDoc.Empty; - rfield_xmldocsig=f; + let a = u_bool st + let b = u_bool st + let c1 = u_typ st + let c2 = u_bool st + let c2b = u_bool st + let c3 = u_option u_const st + let d = u_ident st + // The XmlDoc is only present in the extended in-memory format. We detect its presence using a marker bit here + let xmldoc, e1 = u_attribs_ext u_xmldoc st + let e2 = u_attribs st + let f = u_string st + let g = u_access st + { rfield_mutable=a + rfield_volatile=b + rfield_type=c1 + rfield_static=c2 + rfield_secret=c2b + rfield_const=c3 + rfield_id=d + rfield_pattribs=e1 + rfield_fattribs=e2 + rfield_xmldoc= defaultArg xmldoc XmlDoc.Empty + rfield_xmldocsig=f rfield_access=g rfield_other_range = None } and u_rfield_table st = MakeRecdFieldsTable (u_list u_recdfield_spec st) and u_entity_spec_data st : Entity = - let x1,x2a,x2b,x2c,x3,(x4a,x4b),x6,x7f,x8,x9,x10,x10b,x11,x12,x13,x14,_space = + let x1,x2a,x2b,x2c,x3,(x4a,x4b),x6,x7f,x8,x9,x10,x10b,x11,x12,x13,x14,x15 = u_tup17 u_typar_specs u_string @@ -1912,33 +1976,33 @@ and u_entity_spec_data st : Entity = (u_option u_cpath ) (u_lazy u_modul_typ) u_exnc_repr - (u_space 1) + (u_used_space1 u_xmldoc) st // We use a bit that was unused in the F# 2.0 format to indicate two possible representations in the F# 3.0 tycon_repr format let x7 = x7f (x11 &&& EntityFlags.ReservedBitForPickleFormatTyconReprFlag <> 0L) let x11 = x11 &&& ~~~EntityFlags.ReservedBitForPickleFormatTyconReprFlag - { entity_typars=LazyWithContext.NotLazy x1; - entity_stamp=newStamp(); - entity_logical_name=x2a; - entity_compiled_name=x2b; - entity_range=x2c; - entity_other_range=None; - entity_pubpath=x3; - entity_accessiblity=x4a; - entity_tycon_repr_accessibility=x4b; - entity_attribs=x6; - entity_tycon_repr=x7; - entity_tycon_abbrev=x8; - entity_tycon_tcaug=x9; - entity_xmldoc=XmlDoc.Empty; - entity_xmldocsig=x10; - entity_kind=x10b; - entity_flags=EntityFlags(x11); - entity_cpath=x12; - entity_modul_contents=MaybeLazy.Lazy x13; - entity_exn_info=x14; - entity_il_repr_cache=newCache(); + { entity_typars=LazyWithContext.NotLazy x1 + entity_stamp=newStamp() + entity_logical_name=x2a + entity_compiled_name=x2b + entity_range=x2c + entity_other_range=None + entity_pubpath=x3 + entity_accessiblity=x4a + entity_tycon_repr_accessibility=x4b + entity_attribs=x6 + entity_tycon_repr=x7 + entity_tycon_abbrev=x8 + entity_tycon_tcaug=x9 + entity_xmldoc= defaultArg x15 XmlDoc.Empty + entity_xmldocsig=x10 + entity_kind=x10b + entity_flags=EntityFlags(x11) + entity_cpath=x12 + entity_modul_contents=MaybeLazy.Lazy x13 + entity_exn_info=x14 + entity_il_repr_cache=newCache() } and u_tcaug st = @@ -1954,18 +2018,18 @@ and u_tcaug st = u_bool (u_space 1) st - {tcaug_compare=a1; - tcaug_compare_withc=a2; - tcaug_hash_and_equals_withc=a3; - tcaug_equals=b2; + {tcaug_compare=a1 + tcaug_compare_withc=a2 + tcaug_hash_and_equals_withc=a3 + tcaug_equals=b2 // only used for code generation and checking - hence don't care about the values when reading back in - tcaug_hasObjectGetHashCode=false; - tcaug_adhoc_list= new ResizeArray<_> (c |> List.map (fun (_,vref) -> (false, vref))); - tcaug_adhoc=NameMultiMap.ofList c; - tcaug_interfaces=d; - tcaug_super=e; + tcaug_hasObjectGetHashCode=false + tcaug_adhoc_list= new ResizeArray<_> (c |> List.map (fun (_,vref) -> (false, vref))) + tcaug_adhoc=NameMultiMap.ofList c + tcaug_interfaces=d + tcaug_super=e // pickled type definitions are always closed (i.e. no more intrinsic members allowed) - tcaug_closed=true; + tcaug_closed=true tcaug_abstract=g} and u_tycon_spec st = @@ -1999,9 +2063,9 @@ and u_attrib_arg st = and u_member_info st : ValMemberInfo = let x2,x3,x4,x5 = u_tup4 u_tcref u_MemberFlags (u_list u_slotsig) u_bool st - { ApparentParent=x2; - MemberFlags=x3; - ImplementedSlotSigs=x4; + { ApparentParent=x2 + MemberFlags=x3 + ImplementedSlotSigs=x4 IsImplemented=x5 } and u_tycon_objmodel_kind st = @@ -2040,7 +2104,7 @@ and u_vrefFlags st = | _ -> ufailwith st "u_vrefFlags" and u_ValData st = - let x1,x1z,x1a,x2,x4,x8,x9,x10,x12,x13,x13b,x14,_space = + let x1,x1z,x1a,x2,x4,x8,x9,x10,x12,x13,x13b,x14,x15 = u_tup13 u_string (u_option u_string) @@ -2054,23 +2118,24 @@ and u_ValData st = u_access u_parentref (u_option u_const) - (u_space 1) st - { val_logical_name=x1; - val_compiled_name=x1z; - val_range=(match x1a with None -> range0 | Some(a,_) -> a); - val_other_range=(match x1a with None -> None | Some(_,b) -> Some(b,true)); - val_type=x2; - val_stamp=newStamp(); - val_flags=ValFlags(x4); - val_defn = None; - val_member_info=x8; - val_attribs=x9; - val_repr_info=x10; - val_xmldoc=XmlDoc.Empty; - val_xmldocsig=x12; - val_access=x13; - val_actual_parent=x13b; - val_const=x14; + (u_used_space1 u_xmldoc) + st + { val_logical_name=x1 + val_compiled_name=x1z + val_range=(match x1a with None -> range0 | Some(a,_) -> a) + val_other_range=(match x1a with None -> None | Some(_,b) -> Some(b,true)) + val_type=x2 + val_stamp=newStamp() + val_flags=ValFlags(x4) + val_defn = None + val_member_info=x8 + val_attribs=x9 + val_repr_info=x10 + val_xmldoc= defaultArg x15 XmlDoc.Empty + val_xmldocsig=x12 + val_access=x13 + val_actual_parent=x13b + val_const=x14 } and u_Val st = u_osgn_decl st.ivals u_ValData st @@ -2091,24 +2156,24 @@ and u_modul_typ st = and p_const x st = match x with - | Const.Bool x -> p_byte 0 st; p_bool x st - | Const.SByte x -> p_byte 1 st; p_int8 x st - | Const.Byte x -> p_byte 2 st; p_uint8 x st - | Const.Int16 x -> p_byte 3 st; p_int16 x st - | Const.UInt16 x -> p_byte 4 st; p_uint16 x st - | Const.Int32 x -> p_byte 5 st; p_int32 x st - | Const.UInt32 x -> p_byte 6 st; p_uint32 x st - | Const.Int64 x -> p_byte 7 st; p_int64 x st - | Const.UInt64 x -> p_byte 8 st; p_uint64 x st + | Const.Bool x -> p_byte 0 st; p_bool x st + | Const.SByte x -> p_byte 1 st; p_int8 x st + | Const.Byte x -> p_byte 2 st; p_uint8 x st + | Const.Int16 x -> p_byte 3 st; p_int16 x st + | Const.UInt16 x -> p_byte 4 st; p_uint16 x st + | Const.Int32 x -> p_byte 5 st; p_int32 x st + | Const.UInt32 x -> p_byte 6 st; p_uint32 x st + | Const.Int64 x -> p_byte 7 st; p_int64 x st + | Const.UInt64 x -> p_byte 8 st; p_uint64 x st | Const.IntPtr x -> p_byte 9 st; p_int64 x st | Const.UIntPtr x -> p_byte 10 st; p_uint64 x st - | Const.Single x -> p_byte 11 st; p_single x st - | Const.Double x -> p_byte 12 st; p_int64 (bits_of_float x) st - | Const.Char c -> p_byte 13 st; p_char c st - | Const.String s -> p_byte 14 st; p_string s st - | Const.Unit -> p_byte 15 st - | Const.Zero -> p_byte 16 st - | Const.Decimal s -> p_byte 17 st; p_array p_int32 (System.Decimal.GetBits(s)) st + | Const.Single x -> p_byte 11 st; p_single x st + | Const.Double x -> p_byte 12 st; p_int64 (bits_of_float x) st + | Const.Char c -> p_byte 13 st; p_char c st + | Const.String s -> p_byte 14 st; p_string s st + | Const.Unit -> p_byte 15 st + | Const.Zero -> p_byte 16 st + | Const.Decimal s -> p_byte 17 st; p_array p_int32 (System.Decimal.GetBits(s)) st and u_const st = let tag = u_byte st @@ -2197,44 +2262,44 @@ and u_lval_op_kind st = and p_op x st = match x with - | TOp.UnionCase c -> p_byte 0 st; p_ucref c st + | TOp.UnionCase c -> p_byte 0 st; p_ucref c st | TOp.ExnConstr c -> p_byte 1 st; p_tcref "op" c st | TOp.Tuple tupInfo -> if evalTupInfoIsStruct tupInfo then p_byte 29 st else p_byte 2 st - | TOp.Recd (a,b) -> p_byte 3 st; p_tup2 p_recdInfo (p_tcref "recd op") (a,b) st + | TOp.Recd (a,b) -> p_byte 3 st; p_tup2 p_recdInfo (p_tcref "recd op") (a,b) st | TOp.ValFieldSet (a) -> p_byte 4 st; p_rfref a st | TOp.ValFieldGet (a) -> p_byte 5 st; p_rfref a st - | TOp.UnionCaseTagGet (a) -> p_byte 6 st; p_tcref "cnstr op" a st - | TOp.UnionCaseFieldGet (a,b) -> p_byte 7 st; p_tup2 p_ucref p_int (a,b) st - | TOp.UnionCaseFieldSet (a,b) -> p_byte 8 st; p_tup2 p_ucref p_int (a,b) st - | TOp.ExnFieldGet (a,b) -> p_byte 9 st; p_tup2 (p_tcref "exn op") p_int (a,b) st - | TOp.ExnFieldSet (a,b) -> p_byte 10 st; p_tup2 (p_tcref "exn op") p_int (a,b) st + | TOp.UnionCaseTagGet (a) -> p_byte 6 st; p_tcref "cnstr op" a st + | TOp.UnionCaseFieldGet (a,b) -> p_byte 7 st; p_tup2 p_ucref p_int (a,b) st + | TOp.UnionCaseFieldSet (a,b) -> p_byte 8 st; p_tup2 p_ucref p_int (a,b) st + | TOp.ExnFieldGet (a,b) -> p_byte 9 st; p_tup2 (p_tcref "exn op") p_int (a,b) st + | TOp.ExnFieldSet (a,b) -> p_byte 10 st; p_tup2 (p_tcref "exn op") p_int (a,b) st | TOp.TupleFieldGet (tupInfo,a) -> if evalTupInfoIsStruct tupInfo then p_byte 30 st; p_int a st else p_byte 11 st; p_int a st - | TOp.ILAsm (a,b) -> p_byte 12 st; p_tup2 (p_list p_ILInstr) p_typs (a,b) st - | TOp.RefAddrGet -> p_byte 13 st - | TOp.UnionCaseProof (a) -> p_byte 14 st; p_ucref a st - | TOp.Coerce -> p_byte 15 st - | TOp.TraitCall (b) -> p_byte 16 st; p_trait b st + | TOp.ILAsm (a,b) -> p_byte 12 st; p_tup2 (p_list p_ILInstr) p_typs (a,b) st + | TOp.RefAddrGet -> p_byte 13 st + | TOp.UnionCaseProof (a) -> p_byte 14 st; p_ucref a st + | TOp.Coerce -> p_byte 15 st + | TOp.TraitCall (b) -> p_byte 16 st; p_trait b st | TOp.LValueOp (a,b) -> p_byte 17 st; p_tup2 p_lval_op_kind (p_vref "lval") (a,b) st | TOp.ILCall (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) - -> p_byte 18 st; p_tup11 p_bool p_bool p_bool p_bool p_vrefFlags p_bool p_bool p_ILMethodRef p_typs p_typs p_typs (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) st - | TOp.Array -> p_byte 19 st - | TOp.While _ -> p_byte 20 st - | TOp.For(_,dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st - | TOp.Bytes bytes -> p_byte 22 st; p_bytes bytes st - | TOp.TryCatch _ -> p_byte 23 st - | TOp.TryFinally _ -> p_byte 24 st + -> p_byte 18 st; p_tup11 p_bool p_bool p_bool p_bool p_vrefFlags p_bool p_bool p_ILMethodRef p_typs p_typs p_typs (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) st + | TOp.Array -> p_byte 19 st + | TOp.While _ -> p_byte 20 st + | TOp.For(_,dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st + | TOp.Bytes bytes -> p_byte 22 st; p_bytes bytes st + | TOp.TryCatch _ -> p_byte 23 st + | TOp.TryFinally _ -> p_byte 24 st | TOp.ValFieldGetAddr (a) -> p_byte 25 st; p_rfref a st - | TOp.UInt16s arr -> p_byte 26 st; p_array p_uint16 arr st - | TOp.Reraise -> p_byte 27 st - | TOp.UnionCaseFieldGetAddr (a,b) -> p_byte 28 st; p_tup2 p_ucref p_int (a,b) st + | TOp.UInt16s arr -> p_byte 26 st; p_array p_uint16 arr st + | TOp.Reraise -> p_byte 27 st + | TOp.UnionCaseFieldGetAddr (a,b) -> p_byte 28 st; p_tup2 p_ucref p_int (a,b) st // Note tag byte 29 is taken for struct tuples, see above // Note tag byte 30 is taken for struct tuples, see above | TOp.Goto _ | TOp.Label _ | TOp.Return -> failwith "unexpected backend construct in pickled TAST" @@ -2308,20 +2373,20 @@ and u_op st = and p_expr expr st = match expr with | Expr.Link e -> p_expr !e st - | Expr.Const (x,m,ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_typ (x,m,ty) st - | Expr.Val (a,b,m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a,b,m) st - | Expr.Op(a,b,c,d) -> p_byte 2 st; p_tup4 p_op p_typs p_Exprs p_dummy_range (a,b,c,d) st - | Expr.Sequential (a,b,c,_,d) -> p_byte 3 st; p_tup4 p_expr p_expr p_int p_dummy_range (a,b,(match c with NormalSeq -> 0 | ThenDoSeq -> 1),d) st - | Expr.Lambda (_,a1,b0,b1,c,d,e) -> p_byte 4 st; p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr p_dummy_range p_typ (a1,b0,b1,c,d,e) st - | Expr.TyLambda (_,b,c,d,e) -> p_byte 5 st; p_tup4 p_typar_specs p_expr p_dummy_range p_typ (b,c,d,e) st - | Expr.App (a1,a2,b,c,d) -> p_byte 6 st; p_tup5 p_expr p_typ p_typs p_Exprs p_dummy_range (a1,a2,b,c,d) st - | Expr.LetRec (a,b,c,_) -> p_byte 7 st; p_tup3 p_binds p_expr p_dummy_range (a,b,c) st - | Expr.Let (a,b,c,_) -> p_byte 8 st; p_tup3 p_bind p_expr p_dummy_range (a,b,c) st - | Expr.Match (_,a,b,c,d,e) -> p_byte 9 st; p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_typ (a,b,c,d,e) st - | Expr.Obj(_,b,c,d,e,f,g) -> p_byte 10 st; p_tup6 p_typ (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b,c,d,e,f,g) st - | Expr.StaticOptimization(a,b,c,d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a,b,c,d) st - | Expr.TyChoose (a,b,c) -> p_byte 12 st; p_tup3 p_typar_specs p_expr p_dummy_range (a,b,c) st - | Expr.Quote(ast,_,_,m,ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_typ (ast,m,ty) st + | Expr.Const (x,m,ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_typ (x,m,ty) st + | Expr.Val (a,b,m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a,b,m) st + | Expr.Op(a,b,c,d) -> p_byte 2 st; p_tup4 p_op p_typs p_Exprs p_dummy_range (a,b,c,d) st + | Expr.Sequential (a,b,c,_,d) -> p_byte 3 st; p_tup4 p_expr p_expr p_int p_dummy_range (a,b,(match c with NormalSeq -> 0 | ThenDoSeq -> 1),d) st + | Expr.Lambda (_,a1,b0,b1,c,d,e) -> p_byte 4 st; p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr p_dummy_range p_typ (a1,b0,b1,c,d,e) st + | Expr.TyLambda (_,b,c,d,e) -> p_byte 5 st; p_tup4 p_typar_specs p_expr p_dummy_range p_typ (b,c,d,e) st + | Expr.App (a1,a2,b,c,d) -> p_byte 6 st; p_tup5 p_expr p_typ p_typs p_Exprs p_dummy_range (a1,a2,b,c,d) st + | Expr.LetRec (a,b,c,_) -> p_byte 7 st; p_tup3 p_binds p_expr p_dummy_range (a,b,c) st + | Expr.Let (a,b,c,_) -> p_byte 8 st; p_tup3 p_bind p_expr p_dummy_range (a,b,c) st + | Expr.Match (_,a,b,c,d,e) -> p_byte 9 st; p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_typ (a,b,c,d,e) st + | Expr.Obj(_,b,c,d,e,f,g) -> p_byte 10 st; p_tup6 p_typ (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b,c,d,e,f,g) st + | Expr.StaticOptimization(a,b,c,d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a,b,c,d) st + | Expr.TyChoose (a,b,c) -> p_byte 12 st; p_tup3 p_typar_specs p_expr p_dummy_range (a,b,c) st + | Expr.Quote(ast,_,_,m,ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_typ (ast,m,ty) st and u_expr st = let tag = u_byte st diff --git a/src/fsharp/TastPickle.fsi b/src/fsharp/TastPickle.fsi index 97d3482413..59aa870989 100644 --- a/src/fsharp/TastPickle.fsi +++ b/src/fsharp/TastPickle.fsi @@ -16,7 +16,7 @@ open Microsoft.FSharp.Compiler.TcGlobals [] type PickledDataWithReferences<'RawData> = { /// The data that uses a collection of CcuThunks internally - RawData: 'RawData; + RawData: 'RawData /// The assumptions that need to be fixed up FixupThunks: list } @@ -82,7 +82,7 @@ val internal p_typ : pickler val internal pickleCcuInfo : pickler /// Serialize an arbitrary object using the given pickler -val pickleObjWithDanglingCcus : string -> TcGlobals -> scope:CcuThunk -> pickler<'T> -> 'T -> byte[] +val pickleObjWithDanglingCcus : inMem: bool -> file: string -> TcGlobals -> scope:CcuThunk -> pickler<'T> -> 'T -> byte[] /// The type of state unpicklers read from type ReaderState @@ -142,7 +142,7 @@ val internal u_typ : unpickler val internal unpickleCcuInfo : ReaderState -> PickledCcuInfo /// Deserialize an arbitrary object which may have holes referring to other compilation units -val internal unpickleObjWithDanglingCcus : string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef option -> ('T unpickler) -> byte[] -> PickledDataWithReferences<'T> +val internal unpickleObjWithDanglingCcus : file:string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef option -> ('T unpickler) -> byte[] -> PickledDataWithReferences<'T> diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index aa7b962a83..28420b5d98 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -7,7 +7,6 @@ module internal Microsoft.FSharp.Compiler.Ast #endif open System.Collections.Generic -open Internal.Utilities open Internal.Utilities.Text.Lexing open Internal.Utilities.Text.Parsing open Microsoft.FSharp.Compiler.AbstractIL @@ -18,8 +17,6 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.UnicodeLexing open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.PrettyNaming -open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Range /// The prefix of the names used for the fake namespace path added to all dynamic code entries in FSI.EXE @@ -97,6 +94,7 @@ type XmlDocCollector() = type XmlDoc = | XmlDoc of string[] static member Empty = XmlDocStatics.Empty + member x.NonEmpty = (let (XmlDoc lines) = x in lines.Length <> 0) static member Merge (XmlDoc lines) (XmlDoc lines') = XmlDoc (Array.append lines lines') static member Process (XmlDoc lines) = // This code runs for .XML generation and thus influences cross-project xmldoc tooltips; for within-project tooltips, see XmlDocumentation.fs in the language service diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 5984d6ef1b..b880d24dfb 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -77,7 +77,7 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo override x.ErrorCount = errors override x.DiagnosticSink(err, isError) = - if isError || ReportWarningAsError (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn, tcConfigB.specificWarnAsError, tcConfigB.specificWarnAsWarn, tcConfigB.globalWarnAsError) err then + if isError || ReportWarningAsError tcConfigB.errorSeverityOptions err then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 @@ -92,7 +92,7 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (err.Exception.ToString())) | _ -> () - elif ReportWarning (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn) err then + elif ReportWarning tcConfigB.errorSeverityOptions err then x.HandleIssue(tcConfigB, err, isError) @@ -435,7 +435,7 @@ let GenerateInterfaceData(tcConfig:TcConfig) = let EncodeInterfaceData(tcConfig: TcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) = if GenerateInterfaceData(tcConfig) then - let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile) + let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) // The resource gets written to a file for FSharp.Core let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild if useDataFiles then @@ -463,7 +463,7 @@ let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemappi let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild if useDataFiles then let ccu, modulInfo = data - let bytes = TastPickle.pickleObjWithDanglingCcus outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo + let bytes = TastPickle.pickleObjWithDanglingCcus isIncrementalBuild outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo let optDataFileName = (Filename.chopExtension outfile)+".optdata" File.WriteAllBytes(optDataFileName, bytes) let (ccu, optData) = @@ -471,7 +471,7 @@ let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemappi map2Of2 Optimizer.AbstractOptimizationInfoToEssentials data else data - [ WriteOptimizationData (tcGlobals, outfile, ccu, optData) ] + [ WriteOptimizationData (tcGlobals, outfile, isIncrementalBuild, ccu, optData) ] else [ ] diff --git a/src/fsharp/fsi/Fsi.fsproj b/src/fsharp/fsi/Fsi.fsproj index 5e3d835b7b..66b633519a 100644 --- a/src/fsharp/fsi/Fsi.fsproj +++ b/src/fsharp/fsi/Fsi.fsproj @@ -46,9 +46,7 @@ fsimain.fs - - PreserveNewest - fsi.exe.config + diff --git a/src/fsharp/fsi/fsi.exe.config b/src/fsharp/fsi/app.config similarity index 64% rename from src/fsharp/fsi/fsi.exe.config rename to src/fsharp/fsi/app.config index 61ea7d7f6e..6ae94a8e65 100644 --- a/src/fsharp/fsi/fsi.exe.config +++ b/src/fsharp/fsi/app.config @@ -7,6 +7,10 @@ + + + + diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index b9331351ff..c5e3d54509 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -558,7 +558,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd member x.ResetErrorCount() = (errorCount <- 0) override x.DiagnosticSink(err, isError) = - if isError || ReportWarningAsError (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn, tcConfigB.specificWarnAsError, tcConfigB.specificWarnAsWarn, tcConfigB.globalWarnAsError) err then + if isError || ReportWarningAsError tcConfigB.errorSeverityOptions err then fsiStdinSyphon.PrintError(tcConfigB,err) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) @@ -566,7 +566,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd raise StopProcessing else DoWithErrorColor isError (fun () -> - if ReportWarning (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn) err then + if ReportWarning tcConfigB.errorSeverityOptions err then fsiConsoleOutput.Error.WriteLine() writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isError)) err @@ -2592,7 +2592,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 None -> failwith "Operation failed. The error text has been printed in the error stream. To return the corresponding FSharpErrorInfo use the EvalInteractionNonThrowing, EvalScriptNonThrowing or EvalExpressionNonThrowing" | Choice2Of2 (Some userExn) -> raise userExn - let commitResultNonThrowing tcConfig scriptFile (errorLogger: CompilationErrorLogger) res = + let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationErrorLogger) res = let errs = errorLogger.GetErrors() let userRes = match res with @@ -2600,7 +2600,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 None -> Choice2Of2 (System.Exception "Operation could not be completed due to earlier error") | Choice2Of2 (Some userExn) -> Choice2Of2 userExn - userRes, ErrorHelpers.CreateErrorInfos (tcConfig, true, scriptFile, errs) + userRes, ErrorHelpers.CreateErrorInfos (errorOptions, true, scriptFile, errs) let dummyScriptFileName = "input.fsx" @@ -2725,10 +2725,10 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalExpression(ctok, sourceText, dummyScriptFileName, errorLogger) - |> commitResultNonThrowing tcConfig dummyScriptFileName errorLogger + |> commitResultNonThrowing errorOptions dummyScriptFileName errorLogger member x.EvalInteraction(sourceText) : unit = // Explanation: When the user of the FsiInteractiveSession object calls this method, the @@ -2746,11 +2746,11 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger) - |> commitResultNonThrowing tcConfig "input.fsx" errorLogger - |> function Choice1Of2(_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs + |> commitResultNonThrowing errorOptions "input.fsx" errorLogger + |> function Choice1Of2 (_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs member x.EvalScript(scriptPath) : unit = // Explanation: When the user of the FsiInteractiveSession object calls this method, the @@ -2768,11 +2768,11 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let errorLogger = CompilationErrorLogger("EvalInteraction",tcConfig) + let errorOptions = TcConfig.Create(tcConfigB, validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalScript(ctok, scriptPath, errorLogger) - |> commitResultNonThrowing tcConfig scriptPath errorLogger - |> function Choice1Of2(_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs + |> commitResultNonThrowing errorOptions scriptPath errorLogger + |> function Choice1Of2 (_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs /// Performs these steps: /// - Load the dummy interaction, if any diff --git a/src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj b/src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj index fe7ee65fc5..0e8d910cb9 100644 --- a/src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj +++ b/src/fsharp/fsiAnyCpu/FsiAnyCPU.fsproj @@ -40,10 +40,7 @@ fsimain.fs - - PreserveNewest - fsiAnyCpu.exe.config - + diff --git a/src/fsharp/fsi/fsiAnyCpu.exe.config b/src/fsharp/fsiAnyCpu/app.config similarity index 66% rename from src/fsharp/fsi/fsiAnyCpu.exe.config rename to src/fsharp/fsiAnyCpu/app.config index 494cb3e584..1308027da2 100644 --- a/src/fsharp/fsi/fsiAnyCpu.exe.config +++ b/src/fsharp/fsiAnyCpu/app.config @@ -8,6 +8,10 @@ + + + + diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 97b10d618d..6f0c26c2f7 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -4,10 +4,12 @@ module internal Microsoft.FSharp.Compiler.Lexhelp open System open System.Text + open Internal.Utilities open Internal.Utilities.Collections open Internal.Utilities.Text open Internal.Utilities.Text.Lexing + open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal @@ -41,10 +43,10 @@ type LightSyntaxStatus(initial:bool,warn:bool) = /// Manage lexer resources (string interning) [] type LexResourceManager() = - let strings = new System.Collections.Generic.Dictionary(100) + let strings = new System.Collections.Generic.Dictionary(100) member x.InternIdentifierToken(s) = let mutable res = Unchecked.defaultof<_> - let ok = strings.TryGetValue(s,&res) + let ok = strings.TryGetValue(s, &res) if ok then res else let res = IDENT s (strings.[s] <- res; res) @@ -64,7 +66,7 @@ type LongUnicodeLexResult = | SingleChar of uint16 | Invalid -let mkLexargs (_filename,defines,lightSyntaxStatus,resourceManager,ifdefStack,errorLogger) = +let mkLexargs (_filename, defines, lightSyntaxStatus, resourceManager, ifdefStack, errorLogger) = { defines = defines ifdefStack= ifdefStack lightSyntaxStatus=lightSyntaxStatus @@ -79,13 +81,13 @@ let reusingLexbufForParsing lexbuf f = try f () with e -> - raise (WrappedError(e,(try lexbuf.LexemeRange with _ -> range0))) + raise (WrappedError(e, (try lexbuf.LexemeRange with _ -> range0))) let resetLexbufPos filename (lexbuf: UnicodeLexing.Lexbuf) = lexbuf.EndPos <- Position.FirstLine (fileIndexOfFile filename) /// Reset the lexbuf, configure the initial position with the given filename and call the given function -let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf,filename) f = +let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf, filename) f = resetLexbufPos filename lexbuf reusingLexbufForParsing lexbuf (fun () -> f lexbuf) @@ -93,7 +95,7 @@ let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf,filename) f = // Functions to manipulate lexer transient state //----------------------------------------------------------------------- -let defaultStringFinisher = (fun _endm _b s -> STRING (Encoding.Unicode.GetString(s,0,s.Length))) +let defaultStringFinisher = (fun _endm _b s -> STRING (Encoding.Unicode.GetString(s, 0, s.Length))) let callStringFinisher fin (buf: ByteBuffer) endm b = fin endm b (buf.Close()) @@ -291,7 +293,7 @@ module Keywords = "sealed"; "trait"; "tailcall"; "virtual"; ] let private unreserveWords = - keywordList |> List.choose (function (mode,keyword,_) -> if mode = FSHARP then Some keyword else None) + keywordList |> List.choose (function (mode, keyword, _) -> if mode = FSHARP then Some keyword else None) //------------------------------------------------------------------------ // Keywords @@ -301,9 +303,9 @@ module Keywords = keywordList |> List.map (fun (_, w, _) -> w) let keywordTable = - let tab = System.Collections.Generic.Dictionary(100) - for _,keyword,token in keywordList do - tab.Add(keyword,token) + let tab = System.Collections.Generic.Dictionary(100) + for _, keyword, token in keywordList do + tab.Add(keyword, token) tab let KeywordToken s = keywordTable.[s] @@ -315,7 +317,7 @@ module Keywords = let KeywordOrIdentifierToken args (lexbuf:UnicodeLexing.Lexbuf) s = match keywordTable.TryGetValue s with - | true,v -> + | true, v -> match v with | RESERVED -> warning(ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved(s), lexbuf.LexemeRange)) diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 6713d117de..f627e00157 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -30,7 +30,7 @@ let inline (lsr) (x:int) (y:int) = int32 (uint32 x >>> y) [] [] type pos(code:int32) = - new (l,c) = + new (l, c) = let l = max 0 l let c = max 0 c let p = ( c &&& posColumnMask) @@ -106,15 +106,15 @@ let _ = assert (isSyntheticMask = mask64 isSyntheticShift isSyntheticBitCount) // This is just a standard unique-index table type FileIndexTable() = let indexToFileTable = new ResizeArray<_>(11) - let fileToIndexTable = new Dictionary(11) + let fileToIndexTable = new Dictionary(11) member t.FileToIndex f = let mutable res = 0 - let ok = fileToIndexTable.TryGetValue(f,&res) + let ok = fileToIndexTable.TryGetValue(f, &res) if ok then res else lock fileToIndexTable (fun () -> let mutable res = 0 in - let ok = fileToIndexTable.TryGetValue(f,&res) in + let ok = fileToIndexTable.TryGetValue(f, &res) in if ok then res else let n = indexToFileTable.Count in @@ -137,20 +137,20 @@ let fileIndexTable = new FileIndexTable() let fileIndexOfFile f = fileIndexTable.FileToIndex(f) % maxFileIndex let fileOfFileIndex n = fileIndexTable.IndexToFile(n) -let mkPos l c = pos (l,c) +let mkPos l c = pos (l, c) [] [] type range(code:int64) = static member Zero = range(0L) - new (fidx,bl,bc,el,ec) = + new (fidx, bl, bc, el, ec) = range( int64 fidx ||| (int64 bl <<< startLineShift) ||| (int64 bc <<< startColumnShift) ||| (int64 (el-bl) <<< heightShift) ||| (int64 ec <<< endColumnShift) ) - new (fidx, b:pos, e:pos) = range(fidx,b.Line,b.Column,e.Line,e.Column) + new (fidx, b:pos, e:pos) = range(fidx, b.Line, b.Column, e.Line, e.Column) member r.StartLine = int32((code &&& startLineMask) >>> startLineShift) member r.StartColumn = int32((code &&& startColumnMask) >>> startColumnShift) @@ -175,9 +175,9 @@ let mkFileIndexRange fi b e = range (fi, b, e) (* end representation, start derived ops *) -let posOrder = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order,Int32.order)) +let posOrder = Order.orderOn (fun (p:pos) -> p.Line, p.Column) (Pair.order (Int32.order, Int32.order)) (* rangeOrder: not a total order, but enough to sort on ranges *) -let rangeOrder = Order.orderOn (fun (r:range) -> r.FileName, r.Start) (Pair.order (String.order,posOrder)) +let rangeOrder = Order.orderOn (fun (r:range) -> r.FileName, r.Start) (Pair.order (String.order, posOrder)) let outputPos (os:TextWriter) (m:pos) = fprintf os "(%d,%d)" m.Line m.Column let outputRange (os:TextWriter) (m:range) = fprintf os "%s%a-%a" m.FileName outputPos m.Start outputPos m.End @@ -219,12 +219,12 @@ let rangeStartup = rangeN "startup" 1 let rangeCmdArgs = rangeN "commandLineArgs" 0 let trimRangeToLine (r:range) = - let startL,startC = r.StartLine,r.StartColumn - let endL ,_endC = r.EndLine,r.EndColumn + let startL, startC = r.StartLine, r.StartColumn + let endL , _endC = r.EndLine, r.EndColumn if endL <= startL then r else - let endL,endC = startL+1,0 (* Trim to the start of the next line (we do not know the end of the current line) *) + let endL, endC = startL+1, 0 (* Trim to the start of the next line (we do not know the end of the current line) *) range (r.FileIndex, startL, startC, endL, endC) (* For Diagnostics *) diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 291f380e29..7aa34ed00d 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -28,6 +28,7 @@ and [] FSharpImplementationFileContents = #else and [] internal FSharpImplementationFileContents = #endif + internal new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations member QualifiedName: string diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 98229231b5..4632f3a5d9 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -145,17 +145,17 @@ type ErrorScope() = | None -> err "" /// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationErrorLogger (debugName:string, tcConfig:TcConfig) = +type internal CompilationErrorLogger (debugName: string, options: FSharpErrorSeverityOptions) = inherit ErrorLogger("CompilationErrorLogger("+debugName+")") let mutable errorCount = 0 let diagnostics = new ResizeArray<_>() override x.DiagnosticSink(exn, isError) = - if isError || ReportWarningAsError (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn, tcConfig.specificWarnAsError, tcConfig.specificWarnAsWarn, tcConfig.globalWarnAsError) exn then + if isError || ReportWarningAsError options exn then diagnostics.Add(exn, isError) errorCount <- errorCount + 1 - else if ReportWarning (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn) exn then + else if ReportWarning options exn then diagnostics.Add(exn, isError) override x.ErrorCount = errorCount @@ -177,26 +177,26 @@ type CompilationGlobalsScope(errorLogger:ErrorLogger, phase: BuildPhase) = unwindEL.Dispose() module ErrorHelpers = - let ReportError (tcConfig:TcConfig, allErrors, mainInputFileName, fileInfo, (exn, sev)) = - [ let isError = (sev = FSharpErrorSeverity.Error) || ReportWarningAsError (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn, tcConfig.specificWarnAsError, tcConfig.specificWarnAsWarn, tcConfig.globalWarnAsError) exn - if (isError || ReportWarning (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn) exn) then + let ReportError (options, allErrors, mainInputFileName, fileInfo, (exn, sev)) = + [ let isError = (sev = FSharpErrorSeverity.Error) || ReportWarningAsError options exn + if (isError || ReportWarning options exn) then let oneError trim exn = [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. // Not ideal, but it's hard to see what else to do. let fallbackRange = rangeN mainInputFileName 1 let ei = FSharpErrorInfo.CreateFromExceptionAndAdjustEof (exn, isError, trim, fallbackRange, fileInfo) - if allErrors || (ei.FileName=mainInputFileName) || (ei.FileName=Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation) then + if allErrors || (ei.FileName = mainInputFileName) || (ei.FileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation) then yield ei ] - + let mainError, relatedErrors = SplitRelatedDiagnostics exn yield! oneError false mainError for e in relatedErrors do yield! oneError true e ] - let CreateErrorInfos (tcConfig:TcConfig, allErrors, mainInputFileName, errors) = + let CreateErrorInfos (options, allErrors, mainInputFileName, errors) = let fileInfo = (Int32.MaxValue, Int32.MaxValue) [| for (exn, isError) in errors do - yield! ReportError (tcConfig, allErrors, mainInputFileName, fileInfo, (exn, isError)) |] + yield! ReportError (options, allErrors, mainInputFileName, fileInfo, (exn, isError)) |] //---------------------------------------------------------------------------- @@ -661,7 +661,7 @@ module internal SymbolHelpers = let mutable ToolTipFault = None let GetXmlCommentForMethInfoItem infoReader m d (minfo: MethInfo) = - GetXmlCommentForItemAux (if minfo.HasDirectXmlComment then Some minfo.XmlDoc else None) infoReader m d + GetXmlCommentForItemAux (if minfo.HasDirectXmlComment || minfo.XmlDoc.NonEmpty then Some minfo.XmlDoc else None) infoReader m d let FormatTyparMapping denv (prettyTyparInst: TyparInst) = [ for (tp, ty) in prettyTyparInst -> @@ -918,26 +918,26 @@ module internal SymbolHelpers = GetXmlCommentForItem infoReader m (Item.Value vref) | Item.Value vref | Item.CustomBuilder (_, vref) -> - GetXmlCommentForItemAux (if valRefInThisAssembly g.compilingFslib vref then Some vref.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if valRefInThisAssembly g.compilingFslib vref || vref.XmlDoc.NonEmpty then Some vref.XmlDoc else None) infoReader m item | Item.UnionCase(ucinfo, _) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef then Some ucinfo.UnionCase .XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None) infoReader m item | Item.ActivePatternCase apref -> GetXmlCommentForItemAux (Some apref.ActivePatternVal.XmlDoc) infoReader m item | Item.ExnCase ecref -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib ecref then Some ecref.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib ecref || ecref.XmlDoc.NonEmpty then Some ecref.XmlDoc else None) infoReader m item | Item.RecdField rfinfo -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib rfinfo.TyconRef then Some rfinfo.RecdField.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib rfinfo.TyconRef || rfinfo.TyconRef.XmlDoc.NonEmpty then Some rfinfo.RecdField.XmlDoc else None) infoReader m item | Item.Event einfo -> - GetXmlCommentForItemAux (if einfo.HasDirectXmlComment then Some einfo.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if einfo.HasDirectXmlComment || einfo.XmlDoc.NonEmpty then Some einfo.XmlDoc else None) infoReader m item | Item.Property(_, pinfos) -> let pinfo = pinfos.Head - GetXmlCommentForItemAux (if pinfo.HasDirectXmlComment then Some pinfo.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if pinfo.HasDirectXmlComment || pinfo.XmlDoc.NonEmpty then Some pinfo.XmlDoc else None) infoReader m item | Item.CustomOperation (_, _, Some minfo) | Item.CtorGroup(_, minfo :: _) @@ -945,12 +945,12 @@ module internal SymbolHelpers = GetXmlCommentForMethInfoItem infoReader m item minfo | Item.Types(_, ((TType_app(tcref, _)):: _)) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib tcref then Some tcref.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None) infoReader m item | Item.ModuleOrNamespaces((modref :: _) as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if not definiteNamespace then - GetXmlCommentForItemAux (if entityRefInThisAssembly g.compilingFslib modref then Some modref.XmlDoc else None) infoReader m item + GetXmlCommentForItemAux (if entityRefInThisAssembly g.compilingFslib modref || modref.XmlDoc.NonEmpty then Some modref.XmlDoc else None) infoReader m item else GetXmlCommentForItemAux None infoReader m item @@ -958,11 +958,11 @@ module internal SymbolHelpers = let xmldoc = match argContainer with | Some(ArgumentContainer.Method (minfo)) -> - if minfo.HasDirectXmlComment then Some minfo.XmlDoc else None + if minfo.HasDirectXmlComment || minfo.XmlDoc.NonEmpty then Some minfo.XmlDoc else None | Some(ArgumentContainer.Type(tcref)) -> - if (tyconRefUsesLocalXmlDoc g.compilingFslib tcref) then Some tcref.XmlDoc else None + if tyconRefUsesLocalXmlDoc g.compilingFslib tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None | Some(ArgumentContainer.UnionCase(ucinfo)) -> - if (tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef) then Some ucinfo.UnionCase.XmlDoc else None + if tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None | _ -> None GetXmlCommentForItemAux xmldoc infoReader m item diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index fbcc875783..c36f931fe8 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -235,10 +235,10 @@ type internal CompilationErrorLogger = inherit ErrorLogger /// Create the error logger - new : debugName:string * tcConfig:TcConfig -> CompilationErrorLogger + new: debugName:string * options: FSharpErrorSeverityOptions -> CompilationErrorLogger /// Get the captured errors - member GetErrors : unit -> (PhasedDiagnostic * FSharpErrorSeverity) list + member GetErrors: unit -> (PhasedDiagnostic * FSharpErrorSeverity) list /// This represents the global state established as each task function runs as part of the build. /// @@ -248,5 +248,5 @@ type internal CompilationGlobalsScope = interface IDisposable module internal ErrorHelpers = - val ReportError: TcConfig * allErrors: bool * mainInputFileName: string * fileInfo: (int * int) * (PhasedDiagnostic * FSharpErrorSeverity) -> FSharpErrorInfo list - val CreateErrorInfos: TcConfig * allErrors: bool * mainInputFileName: string * seq<(PhasedDiagnostic * FSharpErrorSeverity)> -> FSharpErrorInfo[] + val ReportError: FSharpErrorSeverityOptions * allErrors: bool * mainInputFileName: string * fileInfo: (int * int) * (PhasedDiagnostic * FSharpErrorSeverity) -> FSharpErrorInfo list + val CreateErrorInfos: FSharpErrorSeverityOptions * allErrors: bool * mainInputFileName: string * seq<(PhasedDiagnostic * FSharpErrorSeverity)> -> FSharpErrorInfo[] diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index f940a554be..89c315001a 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -56,15 +56,15 @@ module internal IncrementalBuild = /// Get the Id for the given ScalarBuildRule. member x.Id = match x with - | ScalarInput(id,_) ->id - | ScalarDemultiplex(id,_,_,_) ->id - | ScalarMap(id,_,_,_) ->id + | ScalarInput(id, _) ->id + | ScalarDemultiplex(id, _, _, _) ->id + | ScalarMap(id, _, _, _) ->id /// Get the Name for the givenScalarExpr. member x.Name = match x with - | ScalarInput(_,n) ->n - | ScalarDemultiplex(_,n,_,_) ->n - | ScalarMap(_,n,_,_) ->n + | ScalarInput(_, n) ->n + | ScalarDemultiplex(_, n, _, _) ->n + | ScalarMap(_, n, _, _) ->n /// A build rule with a vector of outputs and VectorBuildRule = @@ -96,19 +96,19 @@ module internal IncrementalBuild = /// Get the Id for the given VectorBuildRule. member x.Id = match x with - | VectorInput(id,_) -> id - | VectorScanLeft(id,_,_,_,_) -> id - | VectorMap(id,_,_,_) -> id - | VectorStamp (id,_,_,_) -> id - | VectorMultiplex(id,_,_,_) -> id + | VectorInput(id, _) -> id + | VectorScanLeft(id, _, _, _, _) -> id + | VectorMap(id, _, _, _) -> id + | VectorStamp (id, _, _, _) -> id + | VectorMultiplex(id, _, _, _) -> id /// Get the Name for the given VectorBuildRule. member x.Name = match x with - | VectorInput(_,n) -> n - | VectorScanLeft(_,n,_,_,_) -> n - | VectorMap(_,n,_,_) -> n - | VectorStamp (_,n,_,_) -> n - | VectorMultiplex(_,n,_,_) -> n + | VectorInput(_, n) -> n + | VectorScanLeft(_, n, _, _, _) -> n + | VectorMap(_, n, _, _) -> n + | VectorStamp (_, n, _, _) -> n + | VectorMultiplex(_, n, _, _) -> n [] type BuildRuleExpr = @@ -159,16 +159,16 @@ module internal IncrementalBuild = let rec visitVector (ve:VectorBuildRule) acc = match ve with | VectorInput _ -> op (VectorBuildRule ve) acc - | VectorScanLeft(_,_,a,i,_) -> op (VectorBuildRule ve) (visitVector i (visitScalar a acc)) - | VectorMap(_,_,i,_) - | VectorStamp (_,_,i,_) -> op (VectorBuildRule ve) (visitVector i acc) - | VectorMultiplex(_,_,i,_) -> op (VectorBuildRule ve) (visitScalar i acc) + | VectorScanLeft(_, _, a, i, _) -> op (VectorBuildRule ve) (visitVector i (visitScalar a acc)) + | VectorMap(_, _, i, _) + | VectorStamp (_, _, i, _) -> op (VectorBuildRule ve) (visitVector i acc) + | VectorMultiplex(_, _, i, _) -> op (VectorBuildRule ve) (visitScalar i acc) and visitScalar (se:ScalarBuildRule) acc = match se with | ScalarInput _ -> op (ScalarBuildRule se) acc - | ScalarDemultiplex(_,_,i,_) -> op (ScalarBuildRule se) (visitVector i acc) - | ScalarMap(_,_,i,_) -> op (ScalarBuildRule se) (visitScalar i acc) + | ScalarDemultiplex(_, _, i, _) -> op (ScalarBuildRule se) (visitVector i acc) + | ScalarMap(_, _, i, _) -> op (ScalarBuildRule se) (visitScalar i acc) let visitRule (expr:BuildRuleExpr) acc = match expr with @@ -182,12 +182,12 @@ module internal IncrementalBuild = // Create the rules. let createRules() = - { RuleList = names |> List.map (function NamedVectorOutput(v) -> v.Name,VectorBuildRule(v.Expr) - | NamedScalarOutput(s) -> s.Name,ScalarBuildRule(s.Expr)) } + { RuleList = names |> List.map (function NamedVectorOutput(v) -> v.Name, VectorBuildRule(v.Expr) + | NamedScalarOutput(s) -> s.Name, ScalarBuildRule(s.Expr)) } // Ensure that all names are unique. - let ensureUniqueNames (expr:BuildRuleExpr) (acc:Map) = - let AddUniqueIdToNameMapping(id,name)= + let ensureUniqueNames (expr:BuildRuleExpr) (acc:Map) = + let AddUniqueIdToNameMapping(id, name)= match acc.TryFind name with | Some priorId -> if id<>priorId then failwith (sprintf "Two build expressions had the same name: %s" name) @@ -195,11 +195,11 @@ module internal IncrementalBuild = | None-> Map.add name id acc let id = expr.Id let name = expr.Name - AddUniqueIdToNameMapping(id,name) + AddUniqueIdToNameMapping(id, name) // Validate the rule tree let validateRules (rules:BuildRules) = - FoldOverBuildRules(rules,ensureUniqueNames,Map.empty) |> ignore + FoldOverBuildRules(rules, ensureUniqueNames, Map.empty) |> ignore // Convert and validate let rules = createRules() @@ -230,27 +230,27 @@ module internal IncrementalBuild = | Available of obj * DateTime * InputSignature /// Get the available result. Throw an exception if not available. - member x.GetAvailable() = match x with Available(o,_,_) ->o | _ -> failwith "No available result" + member x.GetAvailable() = match x with Available(o, _, _) ->o | _ -> failwith "No available result" /// Get the time stamp if available. Otherwise MaxValue. - member x.Timestamp = match x with Available(_,ts,_) -> ts | InProgress(_,ts) -> ts | _ -> DateTime.MaxValue + member x.Timestamp = match x with Available(_, ts, _) -> ts | InProgress(_, ts) -> ts | _ -> DateTime.MaxValue /// Get the time stamp if available. Otherwise MaxValue. - member x.InputSignature = match x with Available(_,_,signature) -> signature | _ -> UnevaluatedInput + member x.InputSignature = match x with Available(_, _, signature) -> signature | _ -> UnevaluatedInput member x.ResultIsInProgress = match x with | InProgress _ -> true | _ -> false - member x.GetInProgressContinuation ctok = match x with | InProgress (f,_) -> f ctok | _ -> failwith "not in progress" - member x.TryGetAvailable() = match x with | InProgress _ | NotAvailable -> None | Available(obj,dt,i) -> Some (obj,dt,i) + member x.GetInProgressContinuation ctok = match x with | InProgress (f, _) -> f ctok | _ -> failwith "not in progress" + member x.TryGetAvailable() = match x with | InProgress _ | NotAvailable -> None | Available(obj, dt, i) -> Some (obj, dt, i) /// An immutable sparse vector of results. - type ResultVector(size,zeroElementTimestamp,map) = + type ResultVector(size, zeroElementTimestamp, map) = let get slot = match Map.tryFind slot map with | Some result ->result | None->NotAvailable - let asList = lazy List.map (fun i->i,get i) [0..size-1] + let asList = lazy List.map (fun i->i, get i) [0..size-1] - static member OfSize(size) = ResultVector(size,DateTime.MinValue,Map.empty) + static member OfSize(size) = ResultVector(size, DateTime.MinValue, Map.empty) member rv.Size = size member rv.Get slot = get slot member rv.Resize(newsize) = @@ -258,7 +258,7 @@ module internal IncrementalBuild = ResultVector(newsize, zeroElementTimestamp, map |> Map.filter(fun s _ -> s < newsize)) else rv - member rv.Set(slot,value) = + member rv.Set(slot, value) = #if DEBUG if slot<0 then failwith "ResultVector slot less than zero" if slot>=size then failwith "ResultVector slot too big" @@ -266,12 +266,12 @@ module internal IncrementalBuild = ResultVector(size, zeroElementTimestamp, Map.add slot value map) member rv.MaxTimestamp() = - let maximize (lasttimestamp:DateTime) (_,result:Result) = max lasttimestamp result.Timestamp + let maximize (lasttimestamp:DateTime) (_, result:Result) = max lasttimestamp result.Timestamp List.fold maximize zeroElementTimestamp (asList.Force()) member rv.Signature() = let l = asList.Force() - let l = l |> List.map (fun (_,result) -> result.InputSignature) + let l = l |> List.map (fun (_, result) -> result.InputSignature) SingleMappedVectorInput (l|>List.toArray) member rv.FoldLeft f s: 'a = List.fold f s (asList.Force()) @@ -302,20 +302,20 @@ module internal IncrementalBuild = member action.Execute(ctok) = cancellable { match action with - | IndexedAction(id,_taskname,slot,slotcount,timestamp,func) -> let res = func ctok in return IndexedResult(id,slot,slotcount,res,timestamp) - | ScalarAction(id,_taskname,timestamp,inputsig,func) -> let! res = func ctok in return ScalarValuedResult(id,res,timestamp,inputsig) - | VectorAction(id,_taskname,timestamp,inputsig,func) -> let! res = func ctok in return VectorValuedResult(id,res,timestamp,inputsig) - | ResizeResultAction(id,slotcount) -> return ResizeResult(id,slotcount) + | IndexedAction(id, _taskname, slot, slotcount, timestamp, func) -> let res = func ctok in return IndexedResult(id, slot, slotcount, res, timestamp) + | ScalarAction(id, _taskname, timestamp, inputsig, func) -> let! res = func ctok in return ScalarValuedResult(id, res, timestamp, inputsig) + | VectorAction(id, _taskname, timestamp, inputsig, func) -> let! res = func ctok in return VectorValuedResult(id, res, timestamp, inputsig) + | ResizeResultAction(id, slotcount) -> return ResizeResult(id, slotcount) } /// A set of build rules and the corresponding, possibly partial, results from building. [] - type PartialBuild(rules:BuildRules, results:Map) = + type PartialBuild(rules:BuildRules, results:Map) = member bt.Rules = rules member bt.Results = results /// Given an expression, find the expected width. - let rec GetVectorWidthByExpr(bt:PartialBuild,ve:VectorBuildRule) = + let rec GetVectorWidthByExpr(bt:PartialBuild, ve:VectorBuildRule) = let id = ve.Id let KnownValue() = match bt.Results.TryFind id with @@ -325,10 +325,10 @@ module internal IncrementalBuild = | _ -> failwith "Expected vector to have vector result." | None-> None match ve with - | VectorScanLeft(_,_,_,i,_) - | VectorMap(_,_,i,_) - | VectorStamp (_,_,i,_) -> - match GetVectorWidthByExpr(bt,i) with + | VectorScanLeft(_, _, _, i, _) + | VectorMap(_, _, i, _) + | VectorStamp (_, _, i, _) -> + match GetVectorWidthByExpr(bt, i) with | Some _ as r -> r | None -> KnownValue() | VectorInput _ @@ -336,85 +336,85 @@ module internal IncrementalBuild = /// Given an expression name, get the corresponding expression. let GetTopLevelExprByName(bt:PartialBuild, seek:string) = - bt.Rules.RuleList |> List.filter(fun(name,_) ->name=seek) |> List.map (fun(_,root) ->root) |> List.head + bt.Rules.RuleList |> List.filter(fun(name, _) ->name=seek) |> List.map (fun(_, root) ->root) |> List.head /// Get an expression matching the given name. let GetExprByName(bt:PartialBuild, node:INode): BuildRuleExpr = let matchName (expr:BuildRuleExpr) (acc:BuildRuleExpr option): BuildRuleExpr option = if expr.Name = node.Name then Some expr else acc - let matchOption = FoldOverBuildRules(bt.Rules,matchName,None) + let matchOption = FoldOverBuildRules(bt.Rules, matchName, None) Option.get matchOption // Given an Id, find the corresponding expression. let GetExprById(bt:PartialBuild, seek:Id): BuildRuleExpr= let rec vectorExprOfId ve = match ve with - | VectorInput(id,_) ->if seek=id then Some (VectorBuildRule ve) else None - | VectorScanLeft(id,_,a,i,_) -> + | VectorInput(id, _) ->if seek=id then Some (VectorBuildRule ve) else None + | VectorScanLeft(id, _, a, i, _) -> if seek=id then Some (VectorBuildRule ve) else let result = scalarExprOfId(a) match result with Some _ -> result | None->vectorExprOfId i - | VectorMap(id,_,i,_) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i - | VectorStamp (id,_,i,_) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i - | VectorMultiplex(id,_,i,_) ->if seek=id then Some (VectorBuildRule ve) else scalarExprOfId i + | VectorMap(id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i + | VectorStamp (id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i + | VectorMultiplex(id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else scalarExprOfId i and scalarExprOfId se = match se with - | ScalarInput(id,_) ->if seek=id then Some (ScalarBuildRule se) else None - | ScalarDemultiplex(id,_,i,_) ->if seek=id then Some (ScalarBuildRule se) else vectorExprOfId i - | ScalarMap(id,_,i,_) ->if seek=id then Some (ScalarBuildRule se) else scalarExprOfId i + | ScalarInput(id, _) ->if seek=id then Some (ScalarBuildRule se) else None + | ScalarDemultiplex(id, _, i, _) ->if seek=id then Some (ScalarBuildRule se) else vectorExprOfId i + | ScalarMap(id, _, i, _) ->if seek=id then Some (ScalarBuildRule se) else scalarExprOfId i let exprOfId(expr:BuildRuleExpr) = match expr with | ScalarBuildRule se ->scalarExprOfId se | VectorBuildRule ve ->vectorExprOfId ve - let exprs = bt.Rules.RuleList |> List.map (fun(_,root) ->exprOfId(root)) |> List.filter Option.isSome + let exprs = bt.Rules.RuleList |> List.map (fun(_, root) ->exprOfId(root)) |> List.filter Option.isSome match exprs with | Some expr :: _ -> expr | _ -> failwith (sprintf "GetExprById did not find an expression for Id") let GetVectorWidthById (bt:PartialBuild) seek = - match GetExprById(bt,seek) with + match GetExprById(bt, seek) with | ScalarBuildRule _ ->failwith "Attempt to get width of scalar." - | VectorBuildRule ve -> Option.get (GetVectorWidthByExpr(bt,ve)) + | VectorBuildRule ve -> Option.get (GetVectorWidthByExpr(bt, ve)) let GetScalarExprResult (bt:PartialBuild, se:ScalarBuildRule) = match bt.Results.TryFind (se.Id) with | Some resultSet -> - match se,resultSet with - | ScalarInput _,ScalarResult r - | ScalarMap _,ScalarResult r - | ScalarDemultiplex _,ScalarResult r ->r + match se, resultSet with + | ScalarInput _, ScalarResult r + | ScalarMap _, ScalarResult r + | ScalarDemultiplex _, ScalarResult r ->r | _ ->failwith "GetScalarExprResult had no match" | None->NotAvailable let GetVectorExprResultVector (bt:PartialBuild, ve:VectorBuildRule) = match bt.Results.TryFind (ve.Id) with | Some resultSet -> - match ve,resultSet with - | VectorScanLeft _,VectorResult rv - | VectorMap _,VectorResult rv - | VectorInput _,VectorResult rv - | VectorStamp _,VectorResult rv - | VectorMultiplex _,VectorResult rv -> Some rv + match ve, resultSet with + | VectorScanLeft _, VectorResult rv + | VectorMap _, VectorResult rv + | VectorInput _, VectorResult rv + | VectorStamp _, VectorResult rv + | VectorMultiplex _, VectorResult rv -> Some rv | _ -> failwith "GetVectorExprResultVector had no match" | None->None let GetVectorExprResult (bt:PartialBuild, ve:VectorBuildRule, slot) = match bt.Results.TryFind ve.Id with | Some resultSet -> - match ve,resultSet with - | VectorScanLeft _,VectorResult rv - | VectorMap _,VectorResult rv - | VectorInput _,VectorResult rv - | VectorStamp _,VectorResult rv -> rv.Get slot - | VectorMultiplex _,VectorResult rv -> rv.Get slot + match ve, resultSet with + | VectorScanLeft _, VectorResult rv + | VectorMap _, VectorResult rv + | VectorInput _, VectorResult rv + | VectorStamp _, VectorResult rv -> rv.Get slot + | VectorMultiplex _, VectorResult rv -> rv.Get slot | _ -> failwith "GetVectorExprResult had no match" | None->NotAvailable /// Get the maximum build stamp for an output. - let MaxTimestamp(bt:PartialBuild,id) = + let MaxTimestamp(bt:PartialBuild, id) = match bt.Results.TryFind id with | Some resultset -> match resultset with @@ -422,7 +422,7 @@ module internal IncrementalBuild = | VectorResult rv -> rv.MaxTimestamp() | None -> DateTime.MaxValue - let Signature(bt:PartialBuild,id) = + let Signature(bt:PartialBuild, id) = match bt.Results.TryFind id with | Some resultset -> match resultset with @@ -453,83 +453,83 @@ module internal IncrementalBuild = | Scalar of INode * obj /// Declare a named scalar output. - static member ScalarInput (node:Scalar<'T>,value: 'T) = BuildInput.Scalar(node,box value) - static member VectorInput(node:Vector<'T>,values: 'T list) = BuildInput.Vector(node,List.map box values) + static member ScalarInput (node:Scalar<'T>, value: 'T) = BuildInput.Scalar(node, box value) + static member VectorInput(node:Vector<'T>, values: 'T list) = BuildInput.Vector(node, List.map box values) let AvailableAllResultsOfExpr bt expr = let msg = "Expected all results to be available" - AllResultsOfExpr (function Available(o,_,_) -> o | _ -> failwith msg) bt expr + AllResultsOfExpr (function Available(o, _, _) -> o | _ -> failwith msg) bt expr /// Bind a set of build rules to a set of input values. let ToBound(buildRules:BuildRules, inputs: BuildInput list) = let now = DateTime.Now - let rec applyScalarExpr(se,results) = + let rec applyScalarExpr(se, results) = match se with - | ScalarInput(id,n) -> + | ScalarInput(id, n) -> let matches = [ for input in inputs do match input with | BuildInput.Scalar (node, value) -> if node.Name = n then - yield ScalarResult(Available(value,now,BoundInputScalar)) + yield ScalarResult(Available(value, now, BoundInputScalar)) | _ -> () ] List.foldBack (Map.add id) matches results - | ScalarMap(_,_,se,_) ->applyScalarExpr(se,results) - | ScalarDemultiplex(_,_,ve,_) ->ApplyVectorExpr(ve,results) - and ApplyVectorExpr(ve,results) = + | ScalarMap(_, _, se, _) ->applyScalarExpr(se, results) + | ScalarDemultiplex(_, _, ve, _) ->ApplyVectorExpr(ve, results) + and ApplyVectorExpr(ve, results) = match ve with - | VectorInput(id,n) -> + | VectorInput(id, n) -> let matches = [ for input in inputs do match input with | BuildInput.Scalar _ -> () | BuildInput.Vector (node, values) -> if node.Name = n then - let results = values|>List.mapi(fun i value->i,Available(value,now,BoundInputVector)) - yield VectorResult(ResultVector(values.Length,DateTime.MinValue,results|>Map.ofList)) ] + let results = values|>List.mapi(fun i value->i, Available(value, now, BoundInputVector)) + yield VectorResult(ResultVector(values.Length, DateTime.MinValue, results|>Map.ofList)) ] List.foldBack (Map.add id) matches results - | VectorScanLeft(_,_,a,i,_) ->ApplyVectorExpr(i,applyScalarExpr(a,results)) - | VectorMap(_,_,i,_) - | VectorStamp (_,_,i,_) ->ApplyVectorExpr(i,results) - | VectorMultiplex(_,_,i,_) ->applyScalarExpr(i,results) + | VectorScanLeft(_, _, a, i, _) ->ApplyVectorExpr(i, applyScalarExpr(a, results)) + | VectorMap(_, _, i, _) + | VectorStamp (_, _, i, _) ->ApplyVectorExpr(i, results) + | VectorMultiplex(_, _, i, _) ->applyScalarExpr(i, results) let applyExpr expr results = match expr with - | ScalarBuildRule se ->applyScalarExpr(se,results) - | VectorBuildRule ve ->ApplyVectorExpr(ve,results) + | ScalarBuildRule se ->applyScalarExpr(se, results) + | VectorBuildRule ve ->ApplyVectorExpr(ve, results) // Place vector inputs into results map. let results = List.foldBack applyExpr (buildRules.RuleList |> List.map snd) Map.empty - PartialBuild(buildRules,results) + PartialBuild(buildRules, results) type Target = Target of INode * int option /// Visit each executable action necessary to evaluate the given output (with an optional slot in a /// vector output). Call actionFunc with the given accumulator. let ForeachAction cache ctok (Target(output, optSlot)) bt (actionFunc:Action -> 'T -> 'T) (acc:'T) = - let seen = Dictionary() + let seen = Dictionary() let isSeen id = if seen.ContainsKey id then true else seen.[id] <- true false - let shouldEvaluate(bt,currentsig:InputSignature,id) = + let shouldEvaluate(bt, currentsig:InputSignature, id) = if currentsig.IsEvaluated then - currentsig <> Signature(bt,id) + currentsig <> Signature(bt, id) else false /// Make sure the result vector saved matches the size of expr - let resizeVectorExpr(ve:VectorBuildRule,acc) = - match GetVectorWidthByExpr(bt,ve) with + let resizeVectorExpr(ve:VectorBuildRule, acc) = + match GetVectorWidthByExpr(bt, ve) with | Some expectedWidth -> match bt.Results.TryFind ve.Id with | Some found -> match found with | VectorResult rv -> if rv.Size <> expectedWidth then - actionFunc (ResizeResultAction(ve.Id ,expectedWidth)) acc + actionFunc (ResizeResultAction(ve.Id , expectedWidth)) acc else acc | _ -> acc | None -> acc @@ -539,25 +539,25 @@ module internal IncrementalBuild = if isSeen ve.Id then acc else - let acc = resizeVectorExpr(ve,acc) + let acc = resizeVectorExpr(ve, acc) match ve with | VectorInput _ -> acc - | VectorScanLeft(id,taskname,accumulatorExpr,inputExpr,func) -> + | VectorScanLeft(id, taskname, accumulatorExpr, inputExpr, func) -> let acc = - match GetVectorWidthByExpr(bt,ve) with + match GetVectorWidthByExpr(bt, ve) with | Some cardinality -> let limit = match optSlot with None -> cardinality | Some slot -> (slot+1) let Scan slot = let accumulatorResult = - if slot=0 then GetScalarExprResult (bt,accumulatorExpr) - else GetVectorExprResult (bt,ve,slot-1) + if slot=0 then GetScalarExprResult (bt, accumulatorExpr) + else GetVectorExprResult (bt, ve, slot-1) - let inputResult = GetVectorExprResult (bt,inputExpr,slot) - match accumulatorResult,inputResult with - | Available(accumulator,accumulatortimesamp,_accumulatorInputSig),Available(input,inputtimestamp,_inputSig) -> + let inputResult = GetVectorExprResult (bt, inputExpr, slot) + match accumulatorResult, inputResult with + | Available(accumulator, accumulatortimesamp, _accumulatorInputSig), Available(input, inputtimestamp, _inputSig) -> let inputtimestamp = max inputtimestamp accumulatortimesamp - let prevoutput = GetVectorExprResult (bt,ve,slot) + let prevoutput = GetVectorExprResult (bt, ve, slot) let outputtimestamp = prevoutput.Timestamp let scanOpOpt = if inputtimestamp <> outputtimestamp then @@ -568,7 +568,7 @@ module internal IncrementalBuild = // up-to-date and complete, no work required None match scanOpOpt with - | Some scanOp -> Some (actionFunc (IndexedAction(id,taskname,slot,cardinality,inputtimestamp,scanOp)) acc) + | Some scanOp -> Some (actionFunc (IndexedAction(id, taskname, slot, cardinality, inputtimestamp, scanOp)) acc) | None -> None | _ -> None @@ -580,23 +580,23 @@ module internal IncrementalBuild = | VectorMap(id, taskname, inputExpr, func) -> let acc = - match GetVectorWidthByExpr(bt,ve) with + match GetVectorWidthByExpr(bt, ve) with | Some cardinality -> if cardinality=0 then // For vector length zero, just propagate the prior timestamp. - let inputtimestamp = MaxTimestamp(bt,inputExpr.Id) - let outputtimestamp = MaxTimestamp(bt,id) + let inputtimestamp = MaxTimestamp(bt, inputExpr.Id) + let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then - actionFunc (VectorAction(id,taskname,inputtimestamp,EmptyTimeStampedInput inputtimestamp, fun _ -> cancellable.Return [||])) acc + actionFunc (VectorAction(id, taskname, inputtimestamp, EmptyTimeStampedInput inputtimestamp, fun _ -> cancellable.Return [||])) acc else acc else let MapResults acc slot = - let inputtimestamp = GetVectorExprResult(bt,inputExpr,slot).Timestamp - let outputtimestamp = GetVectorExprResult(bt,ve,slot).Timestamp + let inputtimestamp = GetVectorExprResult(bt, inputExpr, slot).Timestamp + let outputtimestamp = GetVectorExprResult(bt, ve, slot).Timestamp if inputtimestamp <> outputtimestamp then let OneToOneOp ctok = - Eventually.Done (func ctok (GetVectorExprResult(bt,inputExpr,slot).GetAvailable())) - actionFunc (IndexedAction(id,taskname,slot,cardinality,inputtimestamp,OneToOneOp)) acc + Eventually.Done (func ctok (GetVectorExprResult(bt, inputExpr, slot).GetAvailable())) + actionFunc (IndexedAction(id, taskname, slot, cardinality, inputtimestamp, OneToOneOp)) acc else acc match optSlot with | None -> @@ -611,24 +611,24 @@ module internal IncrementalBuild = // For every result that is available, check time stamps. let acc = - match GetVectorWidthByExpr(bt,ve) with + match GetVectorWidthByExpr(bt, ve) with | Some cardinality -> if cardinality=0 then // For vector length zero, just propagate the prior timestamp. - let inputtimestamp = MaxTimestamp(bt,inputExpr.Id) - let outputtimestamp = MaxTimestamp(bt,id) + let inputtimestamp = MaxTimestamp(bt, inputExpr.Id) + let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then - actionFunc (VectorAction(id,taskname,inputtimestamp,EmptyTimeStampedInput inputtimestamp,fun _ -> cancellable.Return [||])) acc + actionFunc (VectorAction(id, taskname, inputtimestamp, EmptyTimeStampedInput inputtimestamp, fun _ -> cancellable.Return [||])) acc else acc else let checkStamp acc slot = - let inputresult = GetVectorExprResult (bt,inputExpr,slot) + let inputresult = GetVectorExprResult (bt, inputExpr, slot) match inputresult with - | Available(ires,_,_) -> - let oldtimestamp = GetVectorExprResult(bt,ve,slot).Timestamp + | Available(ires, _, _) -> + let oldtimestamp = GetVectorExprResult(bt, ve, slot).Timestamp let newtimestamp = func cache ctok ires if newtimestamp <> oldtimestamp then - actionFunc (IndexedAction(id,taskname,slot,cardinality,newtimestamp, fun _ -> Eventually.Done ires)) acc + actionFunc (IndexedAction(id, taskname, slot, cardinality, newtimestamp, fun _ -> Eventually.Done ires)) acc else acc | _ -> acc match optSlot with @@ -641,12 +641,12 @@ module internal IncrementalBuild = | VectorMultiplex(id, taskname, inputExpr, func) -> let acc = - match GetScalarExprResult (bt,inputExpr) with - | Available(inp,inputtimestamp,inputsig) -> - let outputtimestamp = MaxTimestamp(bt,id) + match GetScalarExprResult (bt, inputExpr) with + | Available(inp, inputtimestamp, inputsig) -> + let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then let MultiplexOp ctok = func ctok inp |> cancellable.Return - actionFunc (VectorAction(id,taskname,inputtimestamp,inputsig,MultiplexOp)) acc + actionFunc (VectorAction(id, taskname, inputtimestamp, inputsig, MultiplexOp)) acc else acc | _ -> acc visitScalar inputExpr acc @@ -656,39 +656,39 @@ module internal IncrementalBuild = else match se with | ScalarInput _ -> acc - | ScalarDemultiplex (id,taskname,inputExpr,func) -> + | ScalarDemultiplex (id, taskname, inputExpr, func) -> let acc = - match GetVectorExprResultVector (bt,inputExpr) with + match GetVectorExprResultVector (bt, inputExpr) with | Some inputresult -> let currentsig = inputresult.Signature() - if shouldEvaluate(bt,currentsig,id) then + if shouldEvaluate(bt, currentsig, id) then let inputtimestamp = MaxTimestamp(bt, inputExpr.Id) let DemultiplexOp ctok = cancellable { let input = AvailableAllResultsOfExpr bt inputExpr |> List.toArray return! func ctok input } - actionFunc (ScalarAction(id,taskname,inputtimestamp,currentsig,DemultiplexOp)) acc + actionFunc (ScalarAction(id, taskname, inputtimestamp, currentsig, DemultiplexOp)) acc else acc | None -> acc visitVector None inputExpr acc - | ScalarMap (id,taskname,inputExpr,func) -> + | ScalarMap (id, taskname, inputExpr, func) -> let acc = - match GetScalarExprResult (bt,inputExpr) with - | Available(inp,inputtimestamp,inputsig) -> + match GetScalarExprResult (bt, inputExpr) with + | Available(inp, inputtimestamp, inputsig) -> let outputtimestamp = MaxTimestamp(bt, id) if inputtimestamp <> outputtimestamp then let MapOp ctok = func ctok inp |> cancellable.Return - actionFunc (ScalarAction(id,taskname,inputtimestamp,inputsig,MapOp)) acc + actionFunc (ScalarAction(id, taskname, inputtimestamp, inputsig, MapOp)) acc else acc | _ -> acc visitScalar inputExpr acc - let expr = bt.Rules.RuleList |> List.find (fun (s,_) -> s = output.Name) |> snd + let expr = bt.Rules.RuleList |> List.find (fun (s, _) -> s = output.Name) |> snd match expr with | ScalarBuildRule se -> visitScalar se acc | VectorBuildRule ve -> visitVector optSlot ve acc @@ -701,14 +701,14 @@ module internal IncrementalBuild = /// Compute the max timestamp on all available inputs let ComputeMaxTimeStamp cache ctok output (bt: PartialBuild) acc = - let expr = bt.Rules.RuleList |> List.find (fun (s,_) -> s = output) |> snd + let expr = bt.Rules.RuleList |> List.find (fun (s, _) -> s = output) |> snd match expr with | VectorBuildRule (VectorStamp (_id, _taskname, inputExpr, func) as ve) -> - match GetVectorWidthByExpr(bt,ve) with + match GetVectorWidthByExpr(bt, ve) with | Some cardinality -> let CheckStamp acc slot = - match GetVectorExprResult (bt,inputExpr,slot) with - | Available(ires,_,_) -> max acc (func cache ctok ires) + match GetVectorExprResult (bt, inputExpr, slot) with + | Available(ires, _, _) -> max acc (func cache ctok ires) | _ -> acc [0..cardinality-1] |> List.fold CheckStamp acc | None -> acc @@ -717,29 +717,29 @@ module internal IncrementalBuild = /// Given the result of a single action, apply that action to the Build - let ApplyResult(actionResult:ActionResult,bt:PartialBuild) = + let ApplyResult(actionResult:ActionResult, bt:PartialBuild) = match actionResult with - | ResizeResult(id,slotcount) -> + | ResizeResult(id, slotcount) -> match bt.Results.TryFind id with | Some resultSet -> match resultSet with | VectorResult rv -> let rv = rv.Resize(slotcount) let results = Map.add id (VectorResult rv) bt.Results - PartialBuild(bt.Rules,results) + PartialBuild(bt.Rules, results) | _ -> failwith "Unexpected" | None -> failwith "Unexpected" - | ScalarValuedResult(id,value,timestamp,inputsig) -> - PartialBuild(bt.Rules, Map.add id (ScalarResult(Available(value,timestamp,inputsig))) bt.Results) - | VectorValuedResult(id,values,timestamp,inputsig) -> + | ScalarValuedResult(id, value, timestamp, inputsig) -> + PartialBuild(bt.Rules, Map.add id (ScalarResult(Available(value, timestamp, inputsig))) bt.Results) + | VectorValuedResult(id, values, timestamp, inputsig) -> let Append acc slot = - Map.add slot (Available(values.[slot],timestamp,inputsig)) acc + Map.add slot (Available(values.[slot], timestamp, inputsig)) acc let results = [0..values.Length-1]|>List.fold Append Map.empty - let results = VectorResult(ResultVector(values.Length,timestamp,results)) + let results = VectorResult(ResultVector(values.Length, timestamp, results)) let bt = PartialBuild(bt.Rules, Map.add id results bt.Results) bt - | IndexedResult(id,index,slotcount,value,timestamp) -> + | IndexedResult(id, index, slotcount, value, timestamp) -> let width = GetVectorWidthById bt id let priorResults = bt.Results.TryFind id let prior = @@ -751,10 +751,10 @@ module internal IncrementalBuild = let result = match value with | Eventually.Done res -> - Available(res,timestamp, IndexedValueElement timestamp) + Available(res, timestamp, IndexedValueElement timestamp) | Eventually.NotYetDone f -> - InProgress (f,timestamp) - let results = rv.Resize(slotcount).Set(index,result) + InProgress (f, timestamp) + let results = rv.Resize(slotcount).Set(index, result) PartialBuild(bt.Rules, Map.add id (VectorResult(results)) bt.Results) | _ -> failwith "Unexpected" @@ -767,7 +767,7 @@ module internal IncrementalBuild = let ExecuteApply (ctok: CompilationThreadToken) save (action:Action) bt = cancellable { let! actionResult = action.Execute(ctok) - let newBt = ApplyResult(actionResult,bt) + let newBt = ApplyResult(actionResult, bt) save ctok newBt return newBt } @@ -775,7 +775,7 @@ module internal IncrementalBuild = /// Evaluate the result of a single output let EvalLeafsFirst cache ctok save target bt = - let rec eval(bt,gen) = + let rec eval(bt, gen) = cancellable { #if DEBUG // This can happen, for example, if there is a task whose timestamp never stops increasing. @@ -786,15 +786,15 @@ module internal IncrementalBuild = let worklist = CollectActions cache target bt let! newBt = - (bt,worklist) ||> Cancellable.fold (fun bt action -> + (bt, worklist) ||> Cancellable.fold (fun bt action -> if injectCancellationFault then Cancellable.canceled() else ExecuteApply ctok save action bt) - if newBt=bt then return bt else return! eval(newBt,gen+1) + if newBt=bt then return bt else return! eval(newBt, gen+1) } - eval(bt,0) + eval(bt, 0) /// Evaluate one step of the build. Call the 'save' function to save the intermediate result. let Step cache ctok save target (bt:PartialBuild) = @@ -814,7 +814,7 @@ module internal IncrementalBuild = /// Evaluate an output of the build. /// /// Intermediate progress along the way may be saved through the use of the 'save' function. - let Eval cache ctok save node bt = EvalLeafsFirst cache ctok save (Target(node,None)) bt + let Eval cache ctok save node bt = EvalLeafsFirst cache ctok save (Target(node, None)) bt /// Evaluate an output of the build. /// @@ -831,47 +831,47 @@ module internal IncrementalBuild = ComputeMaxTimeStamp cache ctok target bt DateTime.MinValue /// Get a scalar vector. Result must be available - let GetScalarResult<'T>(node:Scalar<'T>,bt): ('T*DateTime) option = - match GetTopLevelExprByName(bt,node.Name) with + let GetScalarResult<'T>(node:Scalar<'T>, bt): ('T*DateTime) option = + match GetTopLevelExprByName(bt, node.Name) with | ScalarBuildRule se -> match bt.Results.TryFind se.Id with | Some result -> match result with | ScalarResult(sr) -> match sr.TryGetAvailable() with - | Some (r,timestamp,_) -> Some (downcast r, timestamp) + | Some (r, timestamp, _) -> Some (downcast r, timestamp) | None -> None | _ ->failwith "Expected a scalar result." | None->None | VectorBuildRule _ -> failwith "Expected scalar." /// Get a result vector. All results must be available or thrown an exception. - let GetVectorResult<'T>(node:Vector<'T>,bt): 'T[] = - match GetTopLevelExprByName(bt,node.Name) with + let GetVectorResult<'T>(node:Vector<'T>, bt): 'T[] = + match GetTopLevelExprByName(bt, node.Name) with | ScalarBuildRule _ -> failwith "Expected vector." | VectorBuildRule ve -> AvailableAllResultsOfExpr bt ve |> List.map unbox |> Array.ofList /// Get an element of vector result or None if there were no results. - let GetVectorResultBySlot<'T>(node:Vector<'T>,slot,bt): ('T*DateTime) option = - match GetTopLevelExprByName(bt,node.Name) with + let GetVectorResultBySlot<'T>(node:Vector<'T>, slot, bt): ('T*DateTime) option = + match GetTopLevelExprByName(bt, node.Name) with | ScalarBuildRule _ -> failwith "Expected vector expression" | VectorBuildRule ve -> - match GetVectorExprResult(bt,ve,slot).TryGetAvailable() with - | Some (o,timestamp,_) -> Some (downcast o,timestamp) + match GetVectorExprResult(bt, ve, slot).TryGetAvailable() with + | Some (o, timestamp, _) -> Some (downcast o, timestamp) | None->None /// Given an input value, find the corresponding slot. - let TryGetSlotByInput<'T>(node:Vector<'T>,build:PartialBuild,found:'T->bool): int option = - let expr = GetExprByName(build,node) + let TryGetSlotByInput<'T>(node:Vector<'T>, build:PartialBuild, found:'T->bool): int option = + let expr = GetExprByName(build, node) let id = expr.Id match build.Results.TryFind id with | None -> None | Some resultSet -> match resultSet with | VectorResult rv -> - let MatchNames acc (slot,result) = + let MatchNames acc (slot, result) = match result with - | Available(o,_,_) -> + | Available(o, _, _) -> let o = o :?> 'T if found o then Some slot else acc | _ -> acc @@ -887,7 +887,7 @@ module internal IncrementalBuild = /// Declares a vector build input. let InputVector<'T> name = - let expr = VectorInput(NextId(),name) + let expr = VectorInput(NextId(), name) { new Vector<'T> interface IVector with override __.Name = name @@ -895,7 +895,7 @@ module internal IncrementalBuild = /// Declares a scalar build input. let InputScalar<'T> name = - let expr = ScalarInput(NextId(),name) + let expr = ScalarInput(NextId(), name) { new Scalar<'T> interface IScalar with override __.Name = name @@ -906,7 +906,7 @@ module internal IncrementalBuild = /// Maps one vector to another using the given function. let Map (taskname:string) (task: CompilationThreadToken -> 'I -> 'O) (input:Vector<'I>): Vector<'O> = let input = input.Expr - let expr = VectorMap(NextId(),taskname,input,(fun ctok x -> box (task ctok (unbox x)))) + let expr = VectorMap(NextId(), taskname, input, (fun ctok x -> box (task ctok (unbox x)))) { new Vector<'O> interface IVector with override __.Name = taskname @@ -919,7 +919,7 @@ module internal IncrementalBuild = let BoxingScanLeft ctok a i = Eventually.box(task ctok (unbox a) (unbox i)) let acc = acc.Expr let input = input.Expr - let expr = VectorScanLeft(NextId(),taskname,acc,input,BoxingScanLeft) + let expr = VectorScanLeft(NextId(), taskname, acc, input, BoxingScanLeft) { new Vector<'A> interface IVector with override __.Name = taskname @@ -933,7 +933,7 @@ module internal IncrementalBuild = return box res } let input = input.Expr - let expr = ScalarDemultiplex(NextId(),taskname,input,BoxingDemultiplex) + let expr = ScalarDemultiplex(NextId(), taskname, input, BoxingDemultiplex) { new Scalar<'O> interface IScalar with override __.Name = taskname @@ -943,7 +943,7 @@ module internal IncrementalBuild = /// timestamp specified by the passed-in function. let Stamp (taskname:string) (task: TimeStampCache -> CompilationThreadToken -> 'I -> DateTime) (input:Vector<'I>): Vector<'I> = let input = input.Expr - let expr = VectorStamp (NextId(),taskname,input,(fun cache ctok x -> task cache ctok (unbox x))) + let expr = VectorStamp (NextId(), taskname, input, (fun cache ctok x -> task cache ctok (unbox x))) { new Vector<'I> interface IVector with override __.Name = taskname @@ -957,15 +957,18 @@ module internal IncrementalBuild = /// Declare build outputs and bind them to real values. type BuildDescriptionScope() = let mutable outputs = [] + /// Declare a named scalar output. member b.DeclareScalarOutput(output:Scalar<'T>)= outputs <- NamedScalarOutput(output) :: outputs + /// Declare a named vector output. member b.DeclareVectorOutput(output:Vector<'T>)= outputs <- NamedVectorOutput(output) :: outputs + /// Set the concrete inputs for this build member b.GetInitialPartialBuild(inputs:BuildInput list) = - ToBound(ToBuild outputs,inputs) + ToBound(ToBuild outputs, inputs) @@ -1034,45 +1037,49 @@ type TypeCheckAccumulator = /// Global service state type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list* (*fsharpBinaries*)string +/// Represents a cache of 'framework' references that can be shared betweeen multiple incremental builds type FrameworkImportsCache(keepStrongly) = // Mutable collection protected via CompilationThreadToken - let frameworkTcImportsCache = AgedLookup(keepStrongly, areSimilar=(fun (x,y) -> x = y)) + let frameworkTcImportsCache = AgedLookup(keepStrongly, areSimilar=(fun (x, y) -> x = y)) + /// Reduce the size of the cache in low-memory scenarios member __.Downsize(ctok) = frameworkTcImportsCache.Resize(ctok, keepStrongly=0) + + /// Clear the cache member __.Clear(ctok) = frameworkTcImportsCache.Clear(ctok) /// This function strips the "System" assemblies from the tcConfig and returns a age-cached TcImports for them. member __.Get(ctok, tcConfig:TcConfig) = cancellable { // Split into installed and not installed. - let frameworkDLLs,nonFrameworkResolutions,unresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) + let frameworkDLLs, nonFrameworkResolutions, unresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) let frameworkDLLsKey = frameworkDLLs |> List.map (fun ar->ar.resolvedPath) // The cache key. Just the minimal data. |> List.sort // Sort to promote cache hits. - let! tcGlobals,frameworkTcImports = + let! tcGlobals, frameworkTcImports = cancellable { // Prepare the frameworkTcImportsCache // // The data elements in this key are very important. There should be nothing else in the TcConfig that logically affects // the import of a set of framework DLLs into F# CCUs. That is, the F# CCUs that result from a set of DLLs (including // FSharp.Core.dll and mscorlib.dll) must be logically invariant of all the other compiler configuration parameters. - let key = (frameworkDLLsKey, + let key = (frameworkDLLsKey, tcConfig.primaryAssembly.Name, - tcConfig.GetTargetFrameworkDirectories(), + tcConfig.GetTargetFrameworkDirectories(), tcConfig.fsharpBinariesDir) match frameworkTcImportsCache.TryGet (ctok, key) with | Some res -> return res | None -> let tcConfigP = TcConfigProvider.Constant(tcConfig) - let! ((tcGlobals,tcImports) as res) = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkResolutions) + let! ((tcGlobals, tcImports) as res) = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkResolutions) frameworkTcImportsCache.Put(ctok, key, res) - return tcGlobals,tcImports + return tcGlobals, tcImports } - return tcGlobals,frameworkTcImports,nonFrameworkResolutions,unresolved + return tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolved } @@ -1084,6 +1091,8 @@ type FrameworkImportsCache(keepStrongly) = // various steps of the process. //----------------------------------------------------------------------------------- + +/// Represents the interim state of checking an assembly type PartialCheckResults = { TcState: TcState TcImports: TcImports @@ -1095,7 +1104,8 @@ type PartialCheckResults = TcSymbolUses: TcSymbolUses list TcDependencyFiles: string list TopAttribs: TopAttribs option - TimeStamp: System.DateTime } + TimeStamp: System.DateTime + ImplementationFiles: TypedImplFile list } static member Create (tcAcc: TypeCheckAccumulator, timestamp) = { TcState = tcAcc.tcState @@ -1108,14 +1118,15 @@ type PartialCheckResults = TcSymbolUses = tcAcc.tcSymbolUses TcDependencyFiles = tcAcc.tcDependencyFiles TopAttribs = tcAcc.topAttribs - TimeStamp = timestamp } + TimeStamp = timestamp + ImplementationFiles = tcAcc.typedImplFiles } [] module Utilities = - let TryFindStringAttribute tcGlobals attribSpec attribs = + let TryFindFSharpStringAttribute tcGlobals attribSpec attribs = match TryFindFSharpAttribute tcGlobals attribSpec attribs with - | Some (Attrib(_,_,[ AttribStringArg(s) ],_,_,_,_)) -> Some s + | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some s | _ -> None /// The implementation of the information needed by TcImports in CompileOps.fs for an F# assembly reference. @@ -1123,7 +1134,7 @@ module Utilities = /// Constructs the build data (IRawFSharpAssemblyData) representing the assembly when used /// as a cross-assembly reference. Note the assembly has not been generated on disk, so this is /// a virtualized view of the assembly contents as computed by background checking. -type RawFSharpAssemblyDataBackedByLanguageService (tcConfig,tcGlobals,tcState:TcState,outfile,topAttrs,assemblyName,ilAssemRef) = +type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, tcState:TcState, outfile, topAttrs, assemblyName, ilAssemRef) = /// Try to find an attribute that takes a string argument @@ -1131,7 +1142,7 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig,tcGlobals,tcState:Tc let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents let sigData = - let _sigDataAttributes,sigDataResources = Driver.EncodeInterfaceData(tcConfig,tcGlobals,exportRemapping,generatedCcu,outfile,true) + let _sigDataAttributes, sigDataResources = Driver.EncodeInterfaceData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true) [ for r in sigDataResources do let ccuName = GetSignatureDataResourceName r let bytes = @@ -1140,14 +1151,14 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig,tcGlobals,tcState:Tc | _ -> assert false; failwith "unreachable" yield (ccuName, bytes) ] - let autoOpenAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindStringAttribute tcGlobals tcGlobals.attrib_AutoOpenAttribute) - let ivtAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute) + let autoOpenAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_AutoOpenAttribute) + let ivtAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute) interface IRawFSharpAssemblyData with member __.GetAutoOpenAttributes(_ilg) = autoOpenAttrs member __.GetInternalsVisibleToAttributes(_ilg) = ivtAttrs member __.TryGetRawILModule() = None - member __.GetRawFSharpSignatureData(_m,_ilShortAssemName,_filename) = sigData - member __.GetRawFSharpOptimizationData(_m,_ilShortAssemName,_filename) = [ ] + member __.GetRawFSharpSignatureData(_m, _ilShortAssemName, _filename) = sigData + member __.GetRawFSharpOptimizationData(_m, _ilShortAssemName, _filename) = [ ] member __.GetRawTypeForwarders() = mkILExportedTypes [] // TODO: cross-project references with type forwarders member __.ShortAssemblyName = assemblyName member __.ILScopeRef = IL.ILScopeRef.Assembly ilAssemRef @@ -1157,8 +1168,8 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig,tcGlobals,tcState:Tc /// Manages an incremental build graph for the build of a single F# project -type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs, nonFrameworkResolutions, unresolvedReferences, tcConfig: TcConfig, projectDirectory, outfile, - assemblyName, niceNameGen: Ast.NiceNameGenerator, lexResourceManager, +type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInputs, nonFrameworkResolutions, unresolvedReferences, tcConfig: TcConfig, projectDirectory, outfile, + assemblyName, niceNameGen: Ast.NiceNameGenerator, lexResourceManager, sourceFiles, loadClosureOpt: LoadClosure option, keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds) = @@ -1170,12 +1181,12 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let projectChecked = new Event() // Check for the existence of loaded sources and prepend them to the sources list if present. - let sourceFiles = tcConfig.GetAvailableLoadedSources() @ (sourceFiles |>List.map (fun s -> rangeStartup,s)) + let sourceFiles = tcConfig.GetAvailableLoadedSources() @ (sourceFiles |>List.map (fun s -> rangeStartup, s)) // Mark up the source files with an indicator flag indicating if they are the last source file in the project let sourceFiles = let flags, isExe = tcConfig.ComputeCanContainEntryPoint(sourceFiles |> List.map snd) - ((sourceFiles,flags) ||> List.map2 (fun (m,nm) flag -> (m,nm,(flag, isExe)))) + ((sourceFiles, flags) ||> List.map2 (fun (m, nm) flag -> (m, nm, (flag, isExe)))) let defaultTimeStamp = DateTime.Now @@ -1183,16 +1194,16 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs [ for (UnresolvedAssemblyReference(referenceText, _)) in unresolvedReferences do // Exclude things that are definitely not a file name if not(FileSystem.IsInvalidPathShim(referenceText)) then - let file = if FileSystem.IsPathRootedShim(referenceText) then referenceText else Path.Combine(projectDirectory,referenceText) + let file = if FileSystem.IsPathRootedShim(referenceText) then referenceText else Path.Combine(projectDirectory, referenceText) yield file for r in nonFrameworkResolutions do yield r.resolvedPath ] let allDependencies = - [ yield! basicDependencies - for (_,f,_) in sourceFiles do - yield f ] + [| yield! basicDependencies + for (_, f, _) in sourceFiles do + yield f |] // The IncrementalBuilder needs to hold up to one item that needs to be disposed, which is the tcImports for the incremental // build. @@ -1225,28 +1236,28 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs cache.GetFileTimeStamp filename // Deduplicate module names - let moduleNamesDict = Dictionary>() + let moduleNamesDict = Dictionary>() /// This is a build task function that gets placed into the build rules as the computation for a VectorMap /// /// Parse the given files and return the given inputs. This function is expected to be /// able to be called with a subset of sourceFiles and return the corresponding subset of /// parsed inputs. - let ParseTask ctok (sourceRange:range,filename:string,isLastCompiland) = + let ParseTask ctok (sourceRange:range, filename:string, isLastCompiland) = assertNotDisposed() DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - let errorLogger = CompilationErrorLogger("ParseTask", tcConfig) + let errorLogger = CompilationErrorLogger("ParseTask", tcConfig.errorSeverityOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parse) try IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed filename) - let input = ParseOneInputFile(tcConfig,lexResourceManager, [], filename ,isLastCompiland,errorLogger,(*retryLocked*)true) + let input = ParseOneInputFile(tcConfig, lexResourceManager, [], filename , isLastCompiland, errorLogger, (*retryLocked*)true) fileParsed.Trigger (filename) let result = Option.map (DeduplicateParsedInputModuleName moduleNamesDict) input - result,sourceRange,filename,errorLogger.GetErrors () + result, sourceRange, filename, errorLogger.GetErrors () with exn -> System.Diagnostics.Debug.Assert(false, sprintf "unexpected failure in IncrementalFSharpBuild.Parse\nerror = %s" (exn.ToString())) failwith "last chance failure" @@ -1266,7 +1277,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let CombineImportedAssembliesTask ctok _ : Cancellable = cancellable { assertNotDisposed() - let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig) + let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1306,7 +1317,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs | Some loadClosure -> for inp in loadClosure.Inputs do for (err, isError) in inp.MetaCommandDiagnostics do - yield err,(if isError then FSharpErrorSeverity.Error else FSharpErrorSeverity.Warning) ] + yield err, (if isError then FSharpErrorSeverity.Error else FSharpErrorSeverity.Warning) ] let tcAcc = { tcGlobals=tcGlobals @@ -1330,8 +1341,8 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs match input with | Some input, _sourceRange, filename, parseErrors-> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked filename) - let capturingErrorLogger = CompilationErrorLogger("TypeCheckTask", tcConfig) - let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false,GetScopedPragmasForInput(input),capturingErrorLogger) + let capturingErrorLogger = CompilationErrorLogger("TypeCheckTask", tcConfig.errorSeverityOptions) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) let fullComputation = eventually { beforeFileChecked.Trigger (filename) @@ -1340,14 +1351,14 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let sink = TcResultsSinkImpl(tcAcc.tcGlobals) let hadParseErrors = not (List.isEmpty parseErrors) - let! (tcEnvAtEndOfFile,topAttribs,typedImplFiles),tcState = + let! (tcEnvAtEndOfFile, topAttribs, typedImplFiles), tcState = TypeCheckOneInputEventually - ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), - tcConfig,tcAcc.tcImports, - tcAcc.tcGlobals, - None, - TcResultsSink.WithSink sink, - tcAcc.tcState,input) + ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), + tcConfig, tcAcc.tcImports, + tcAcc.tcGlobals, + None, + TcResultsSink.WithSink sink, + tcAcc.tcState, input) /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away let typedImplFiles = if keepAssemblyContents then typedImplFiles else [] @@ -1395,24 +1406,24 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs assertNotDisposed() DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig) + let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) // Get the state at the end of the type-checking of the last file let finalAcc = tcStates.[tcStates.Length-1] // Finish the checking - let (_tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState = + let (_tcEnvAtEndOfLastFile, topAttrs, mimpls), tcState = let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnvAtEndOfFile, defaultArg acc.topAttribs EmptyTopAttrs, acc.typedImplFiles) - TypeCheckMultipleInputsFinish (results,finalAcc.tcState) + TypeCheckMultipleInputsFinish (results, finalAcc.tcState) let ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = try - // TypeCheckClosedInputSetFinish fills in tcState.Ccu but in incremental scenarios we don't want this, + // 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) + let tcState, tcAssemblyExpr = TypeCheckClosedInputSetFinish (mimpls, tcState) // Compute the identity of the generated assembly based on attributes, options etc. // Some of this is duplicated from fsc.fs @@ -1426,9 +1437,9 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs with e -> errorRecoveryNoRange e None - let locale = TryFindStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs + let locale = TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs let assemVerFromAttrib = - TryFindStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs + TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs |> Option.bind (fun v -> try Some (parseILVersion v) with _ -> None) let ver = match assemVerFromAttrib with @@ -1441,11 +1452,11 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs // Assemblies containing type provider components can not successfully be used via cross-assembly references. // We return 'None' for the assembly portion of the cross-assembly reference let hasTypeProviderAssemblyAttrib = - topAttrs.assemblyAttrs |> List.exists (fun (Attrib(tcref,_,_,_,_,_,_)) -> tcref.CompiledRepresentationForNamedType.BasicQualifiedName = typeof.FullName) + topAttrs.assemblyAttrs |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> tcref.CompiledRepresentationForNamedType.BasicQualifiedName = typeof.FullName) if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then None else - Some (RawFSharpAssemblyDataBackedByLanguageService (tcConfig,tcGlobals,tcState,outfile,topAttrs,assemblyName,ilAssemRef) :> IRawFSharpAssemblyData) + Some (RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, tcState, outfile, topAttrs, assemblyName, ilAssemRef) :> IRawFSharpAssemblyData) with e -> errorRecoveryNoRange e @@ -1473,7 +1484,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs // Inputs let fileNamesNode = InputVector "FileNames" - let referencedAssembliesNode = InputVector*(TimeStampCache -> CompilationThreadToken -> DateTime)> "ReferencedAssemblies" + let referencedAssembliesNode = InputVector*(TimeStampCache -> CompilationThreadToken -> DateTime)> "ReferencedAssemblies" // Build let stampedFileNamesNode = Vector.Stamp "SourceFileTimeStamps" StampFileNameTask fileNamesNode @@ -1537,7 +1548,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs member __.FileChecked = fileChecked.Publish member __.ProjectChecked = projectChecked.Publish member __.ImportedCcusInvalidated = importsInvalidated.Publish - member __.AllDependenciesDeprecated = allDependencies + member __.AllDependenciesDeprecated = allDependencies #if EXTENSIONTYPING member __.ThereAreLiveTypeProviders = @@ -1566,11 +1577,11 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let slotOfFile = builder.GetSlotOfFileName filename let result = match slotOfFile with - | (*first file*) 0 -> GetScalarResult(initialTcAccNode,partialBuild) - | _ -> GetVectorResultBySlot(tcStatesNode,slotOfFile-1,partialBuild) + | (*first file*) 0 -> GetScalarResult(initialTcAccNode, partialBuild) + | _ -> GetVectorResultBySlot(tcStatesNode, slotOfFile-1, partialBuild) match result with - | Some (tcAcc,timestamp) -> Some (PartialCheckResults.Create (tcAcc,timestamp)) + | Some (tcAcc, timestamp) -> Some (PartialCheckResults.Create (tcAcc, timestamp)) | _ -> None @@ -1589,14 +1600,14 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs match slotOfFile with | (*first file*) 0 -> let! build = IncrementalBuild.Eval cache ctok SavePartialBuild initialTcAccNode partialBuild - return GetScalarResult(initialTcAccNode,build) + return GetScalarResult(initialTcAccNode, build) | _ -> let! build = IncrementalBuild.EvalUpTo cache ctok SavePartialBuild (tcStatesNode, (slotOfFile-1)) partialBuild - return GetVectorResultBySlot(tcStatesNode,slotOfFile-1,build) + return GetVectorResultBySlot(tcStatesNode, slotOfFile-1, build) } match result with - | Some (tcAcc,timestamp) -> return PartialCheckResults.Create (tcAcc,timestamp) + | Some (tcAcc, timestamp) -> return PartialCheckResults.Create (tcAcc, timestamp) | None -> return! failwith "Build was not evaluated, expected the results to be ready after 'Eval' (GetCheckResultsBeforeSlotInProject)." } @@ -1615,13 +1626,13 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs cancellable { let cache = TimeStampCache(defaultTimeStamp) let! build = IncrementalBuild.Eval cache ctok SavePartialBuild finalizedTypeCheckNode partialBuild - match GetScalarResult(finalizedTypeCheckNode,build) with + match GetScalarResult(finalizedTypeCheckNode, build) with | Some ((ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, tcAcc), timestamp) -> - return PartialCheckResults.Create (tcAcc,timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt + return PartialCheckResults.Create (tcAcc, timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt | None -> // helpers to diagnose https://github.com/Microsoft/visualfsharp/pull/2460/ - let brname = match GetTopLevelExprByName(build,finalizedTypeCheckNode.Name) with ScalarBuildRule se ->se.Id | _ -> Id 0xdeadbeef - let data = (finalizedTypeCheckNode.Name, ((build.Results :> IDictionary<_,_>).Keys |> Seq.toArray), brname, build.Results.ContainsKey brname, build.Results.TryFind brname |> Option.map (function ScalarResult(sr) -> Some(sr.TryGetAvailable().IsSome) | _ -> None)) + let brname = match GetTopLevelExprByName(build, finalizedTypeCheckNode.Name) with ScalarBuildRule se ->se.Id | _ -> Id 0xdeadbeef + let data = (finalizedTypeCheckNode.Name, ((build.Results :> IDictionary<_, _>).Keys |> Seq.toArray), brname, build.Results.ContainsKey brname, build.Results.TryFind brname |> Option.map (function ScalarResult(sr) -> Some(sr.TryGetAvailable().IsSome) | _ -> None)) let msg = sprintf "Build was not evaluated, expected the results to be ready after 'Eval' (GetCheckResultsAndImplementationsForProject, data = %A)." data return! failwith msg } @@ -1633,17 +1644,17 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs member __.GetSlotOfFileName(filename:string) = // Get the slot of the given file and force it to build. - let CompareFileNames (_,f2,_) = + let CompareFileNames (_, f2, _) = let result = - String.Compare(filename,f2,StringComparison.CurrentCultureIgnoreCase)=0 - || String.Compare(FileSystem.GetFullPathShim(filename),FileSystem.GetFullPathShim(f2),StringComparison.CurrentCultureIgnoreCase)=0 + String.Compare(filename, f2, StringComparison.CurrentCultureIgnoreCase)=0 + || String.Compare(FileSystem.GetFullPathShim(filename), FileSystem.GetFullPathShim(f2), StringComparison.CurrentCultureIgnoreCase)=0 result - match TryGetSlotByInput(fileNamesNode,partialBuild,CompareFileNames) with + match TryGetSlotByInput(fileNamesNode, partialBuild, CompareFileNames) with | Some slot -> slot | None -> failwith (sprintf "The file '%s' was not part of the project. Did you call InvalidateConfiguration when the list of files in the project changed?" filename) member __.GetSlotsCount () = - let expr = GetExprByName(partialBuild,fileNamesNode) + let expr = GetExprByName(partialBuild, fileNamesNode) match partialBuild.Results.TryFind(expr.Id) with | Some (VectorResult vr) -> vr.Size | _ -> failwith "Failed to find sizes" @@ -1652,22 +1663,22 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs cancellable { let slotOfFile = builder.GetSlotOfFileName filename #if FCS_RETAIN_BACKGROUND_PARSE_RESULTS - match GetVectorResultBySlot(parseTreesNode,slotOfFile,partialBuild) with + match GetVectorResultBySlot(parseTreesNode, slotOfFile, partialBuild) with | Some (results, _) -> return results | None -> let! build = IncrementalBuild.EvalUpTo ctok SavePartialBuild (parseTreesNode, slotOfFile) partialBuild - match GetVectorResultBySlot(parseTreesNode,slotOfFile,build) with + match GetVectorResultBySlot(parseTreesNode, slotOfFile, build) with | Some (results, _) -> return results | None -> return! failwith "Build was not evaluated, expected the results to be ready after 'Eval' (GetParseResultsForFile)." #else let! results = cancellable { - match GetVectorResultBySlot(stampedFileNamesNode,slotOfFile,partialBuild) with + match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, partialBuild) with | Some (results, _) -> return results | None -> let cache = TimeStampCache(defaultTimeStamp) let! build = IncrementalBuild.EvalUpTo cache ctok SavePartialBuild (stampedFileNamesNode, slotOfFile) partialBuild - match GetVectorResultBySlot(stampedFileNamesNode,slotOfFile,build) with + match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, build) with | Some (results, _) -> return results | None -> return! failwith "Build was not evaluated, expected the results to be ready after 'Eval' (GetParseResultsForFile)." } @@ -1676,7 +1687,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs #endif } - member __.SourceFiles = sourceFiles |> List.map (fun (_,f,_) -> f) + member __.SourceFiles = sourceFiles |> List.map (fun (_, f, _) -> f) /// CreateIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. @@ -1731,15 +1742,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs | None -> () // Apply command-line arguments and collect more source files if they are in the arguments - let sourceFilesNew = - try - let sourceFilesAcc = ResizeArray(sourceFiles) - let collect name = if not (Filename.isDll name) then sourceFilesAcc.Add name - ParseCompilerOptions (collect, GetCoreServiceCompilerOptions tcConfigB, commandLineArgs) - sourceFilesAcc |> ResizeArray.toList - with e -> - errorRecovery e range0 - sourceFiles + let sourceFilesNew = ApplyCommandLineArgs(tcConfigB, sourceFiles, commandLineArgs) // Never open PDB files for the language service, even if --standalone is specified tcConfigB.openDebugInformationForLaterStaticLinking <- false @@ -1755,15 +1758,15 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let dllReferences = [for reference in tcConfigB.referencedDLLs do // If there's (one or more) resolutions of closure references then yield them all - match loadClosure.References |> List.tryFind (fun (resolved,_)->resolved=reference.Text) with - | Some (resolved,closureReferences) -> + match loadClosure.References |> List.tryFind (fun (resolved, _)->resolved=reference.Text) with + | Some (resolved, closureReferences) -> for closureReference in closureReferences do yield AssemblyReference(closureReference.originalReference.Range, resolved, None) | None -> yield reference] tcConfigB.referencedDLLs <- [] // Add one by one to remove duplicates dllReferences |> List.iter (fun dllReference -> - tcConfigB.AddReferencedAssemblyByPath(dllReference.Range,dllReference.Text)) + tcConfigB.AddReferencedAssemblyByPath(dllReference.Range, dllReference.Text)) tcConfigB.knownUnresolvedReferences <- loadClosure.UnresolvedReferences | None -> () @@ -1776,11 +1779,12 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs // Resolve assemblies and create the framework TcImports. This is done when constructing the // builder itself, rather than as an incremental task. This caches a level of "system" references. No type providers are // included in these references. - let! (tcGlobals,frameworkTcImports,nonFrameworkResolutions,unresolvedReferences) = frameworkTcImportsCache.Get(ctok, tcConfig) + let! (tcGlobals, frameworkTcImports, nonFrameworkResolutions, unresolvedReferences) = frameworkTcImportsCache.Get(ctok, tcConfig) // Note we are not calling errorLogger.GetErrors() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", tcConfig) + let errorOptions = tcConfig.errorSeverityOptions + let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1791,7 +1795,7 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs let nonFrameworkAssemblyInputs = // Note we are not calling errorLogger.GetErrors() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", tcConfig) + let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1803,9 +1807,9 @@ type IncrementalBuilder(tcGlobals,frameworkTcImports, nonFrameworkAssemblyInputs yield Choice2Of2 pr, (fun (cache: TimeStampCache) ctok -> cache.GetProjectReferenceTimeStamp (pr, ctok)) ] let builder = - new IncrementalBuilder(tcGlobals,frameworkTcImports,nonFrameworkAssemblyInputs,nonFrameworkResolutions,unresolvedReferences, - tcConfig, projectDirectory, outfile, assemblyName, niceNameGen, - resourceManager, sourceFilesNew, loadClosureOpt, + new IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInputs, nonFrameworkResolutions, unresolvedReferences, + tcConfig, projectDirectory, outfile, assemblyName, niceNameGen, + resourceManager, sourceFilesNew, loadClosureOpt, keepAssemblyContents=keepAssemblyContents, keepAllBackgroundResolutions=keepAllBackgroundResolutions, maxTimeShareMilliseconds=maxTimeShareMilliseconds) diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index 3364cf212c..cca9dba7f9 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -59,7 +59,10 @@ type internal PartialCheckResults = /// Represents the collected attributes to apply to the module of assuembly generates TopAttribs: TypeChecker.TopAttribs option - TimeStamp: DateTime } + TimeStamp: DateTime + + /// Represents complete typechecked implementation files, including thier typechecked signatures if any. + ImplementationFiles: TypedImplFile list } /// Manages an incremental build graph for the build of an F# project [] @@ -93,7 +96,7 @@ type internal IncrementalBuilder = member ImportedCcusInvalidated : IEvent /// The list of files the build depends on - member AllDependenciesDeprecated : string list + member AllDependenciesDeprecated : string[] #if EXTENSIONTYPING /// Whether there are any 'live' type providers that may need a refresh when a project is Cleaned member ThereAreLiveTypeProviders : bool diff --git a/src/fsharp/vs/Reactor.fs b/src/fsharp/vs/Reactor.fs index 7aa7d82c7e..cc14a3d2fc 100755 --- a/src/fsharp/vs/Reactor.fs +++ b/src/fsharp/vs/Reactor.fs @@ -35,7 +35,7 @@ type Reactor() = static let theReactor = Reactor() let mutable pauseBeforeBackgroundWork = pauseBeforeBackgroundWorkDefault - // We need to store the culture for the VS thread that is executing now, + // We need to store the culture for the VS thread that is executing now, // so that when the reactor picks up a thread from the threadpool we can set the culture let culture = new CultureInfo(CultureInfo.CurrentUICulture.Name) @@ -134,7 +134,7 @@ type Reactor() = try do! loop (None, None, false) with e -> - Debug.Assert(false,String.Format("unexpected failure in reactor loop {0}, restarting", e)) + Debug.Assert(false, String.Format("unexpected failure in reactor loop {0}, restarting", e)) } // [Foreground Mailbox Accessors] ----------------------------------------------------------- @@ -172,7 +172,7 @@ type Reactor() = async { let! ct = Async.CancellationToken let resultCell = AsyncUtil.AsyncResultCell<_>() - r.EnqueueOpPrim(userOpName, opName, opArg, ct, + r.EnqueueOpPrim(userOpName, opName, opArg, ct, op=(fun ctok -> let result = try @@ -181,7 +181,7 @@ type Reactor() = | ValueOrCancelled.Cancelled e -> AsyncUtil.AsyncCanceled e with e -> e |> AsyncUtil.AsyncException - resultCell.RegisterResult(result)), + resultCell.RegisterResult(result)), ccont=(fun () -> resultCell.RegisterResult (AsyncUtil.AsyncCanceled(OperationCanceledException(ct))) ) ) diff --git a/src/fsharp/vs/ServiceDeclarationLists.fs b/src/fsharp/vs/ServiceDeclarationLists.fs index e6c4a55ccd..a36dc3ce69 100644 --- a/src/fsharp/vs/ServiceDeclarationLists.fs +++ b/src/fsharp/vs/ServiceDeclarationLists.fs @@ -40,11 +40,24 @@ module EnvMisc3 = [] +/// Represents one parameter for one method (or other item) in a group. type FSharpMethodGroupItemParameter(name: string, canonicalTypeTextForSorting: string, display: layout, isOptional: bool) = + + /// The name of the parameter. member __.ParameterName = name + + /// A key that can be used for sorting the parameters, used to help sort overloads. member __.CanonicalTypeTextForSorting = canonicalTypeTextForSorting + + /// The structured representation for the parameter including its name, its type and visual indicators of other + /// information such as whether it is optional. member __.StructuredDisplay = display + + /// The text to display for the parameter including its name, its type and visual indicators of other + /// information such as whether it is optional. member __.Display = showL display + + /// Is the parameter optional member __.IsOptional = isOptional [] @@ -688,19 +701,37 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[], isForT -/// A single method for Intellisense completion -[] +/// Represents one method (or other item) in a method group. The item may represent either a method or +/// a single, non-overloaded item such as union case or a named function value. // Note: instances of this type do not hold any references to any compiler resources. +[] type FSharpMethodGroupItem(description: FSharpToolTipText, xmlDoc: FSharpXmlDoc, returnType: layout, parameters: FSharpMethodGroupItemParameter[], hasParameters: bool, hasParamArrayArg: bool, staticParameters: FSharpMethodGroupItemParameter[]) = + + /// The structured description representation for the method (or other item) member __.StructuredDescription = description + + /// The formatted description text for the method (or other item) member __.Description = Tooltips.ToFSharpToolTipText description + + /// The documentation for the item member __.XmlDoc = xmlDoc + + /// The The structured description representation for the method (or other item) member __.StructuredReturnTypeText = returnType + + /// The formatted type text for the method (or other item) member __.ReturnTypeText = showL returnType + + /// The parameters of the method in the overload set member __.Parameters = parameters + + /// Does the method support an arguments list? This is always true except for static type instantiations like TP<42,"foo">. member __.HasParameters = hasParameters + + /// Does the method support a params list arg? member __.HasParamArrayArg = hasParamArrayArg - // Does the type name or method support a static arguments list, like TP<42,"foo"> or conn.CreateCommand<42, "foo">(arg1, arg2)? + + /// Does the type name or method support a static arguments list, like TP<42,"foo"> or conn.CreateCommand<42, "foo">(arg1, arg2)? member __.StaticParameters = staticParameters diff --git a/src/fsharp/vs/ServiceDeclarationLists.fsi b/src/fsharp/vs/ServiceDeclarationLists.fsi index 4b37270d23..1ed6e5d4e1 100644 --- a/src/fsharp/vs/ServiceDeclarationLists.fsi +++ b/src/fsharp/vs/ServiceDeclarationLists.fsi @@ -27,25 +27,37 @@ type internal FSharpDeclarationListItem = #endif /// Get the display name for the declaration. member Name : string + /// Get the name for the declaration as it's presented in source code. member NameInCode : string + /// Get the description text for the declaration. Computing this property may require using compiler /// resources and may trigger execution of a type provider method to retrieve documentation. /// /// May return "Loading..." if timeout occurs member StructuredDescriptionText : FSharpStructuredToolTipText + member DescriptionText : FSharpToolTipText /// Get the description text, asynchronously. Never returns "Loading...". member StructuredDescriptionTextAsync : Async + member DescriptionTextAsync : Async + member Glyph : FSharpGlyph + member Accessibility : FSharpAccessibility option + member Kind : CompletionItemKind + member IsOwnMember : bool + member MinorPriority : int + member FullName : string + member IsResolved : bool + member NamespaceToOpen : string option @@ -59,13 +71,18 @@ type FSharpDeclarationListInfo = #else type internal FSharpDeclarationListInfo = #endif + member Items : FSharpDeclarationListItem[] + member IsForType : bool + member IsError : bool // Implementation details used by other code in the compiler static member internal Create : infoReader:InfoReader * m:range * denv:DisplayEnv * getAccessibility:(Item -> FSharpAccessibility option) * items:CompletionItem list * reactor:IReactorOperations * currentNamespace:string[] option * isAttributeApplicationContex:bool * checkAlive:(unit -> bool) -> FSharpDeclarationListInfo + static member internal Error : message:string -> FSharpDeclarationListInfo + static member Empty : FSharpDeclarationListInfo /// Represents one parameter for one method (or other item) in a group. diff --git a/src/fsharp/vs/ServiceParamInfoLocations.fs b/src/fsharp/vs/ServiceParamInfoLocations.fs index 0150222b0b..987d10c2de 100755 --- a/src/fsharp/vs/ServiceParamInfoLocations.fs +++ b/src/fsharp/vs/ServiceParamInfoLocations.fs @@ -34,7 +34,7 @@ module internal NoteworthyParamInfoLocationsImpl = let isStaticArg a = match a with | SynType.StaticConstant _ | SynType.StaticConstantExpr _ | SynType.StaticConstantNamed _ -> true - | SynType.LongIdent _ -> true // NOTE: this is not a static constant, but it is a prefix of incomplete code, e.g. "TP<42,Arg3" is a prefix of "TP<42,Arg3=6>" and Arg3 shows up as a LongId + | SynType.LongIdent _ -> true // NOTE: this is not a static constant, but it is a prefix of incomplete code, e.g. "TP<42, Arg3" is a prefix of "TP<42, Arg3=6>" and Arg3 shows up as a LongId | _ -> false /// Dig out an identifier from an expression that used in an application @@ -42,8 +42,8 @@ module internal NoteworthyParamInfoLocationsImpl = // we found it, dig out ident match synExpr with | SynExpr.Ident(id) -> Some ([id.idText], id.idRange) - | SynExpr.LongIdent(_, LongIdentWithDots(lid,_), _, lidRange) - | SynExpr.DotGet(_, _, LongIdentWithDots(lid,_), lidRange) -> Some (pathOfLid lid, lidRange) + | SynExpr.LongIdent(_, LongIdentWithDots(lid, _), _, lidRange) + | SynExpr.DotGet(_, _, LongIdentWithDots(lid, _), lidRange) -> Some (pathOfLid lid, lidRange) | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> digOutIdentFromFuncExpr synExpr | _ -> None @@ -53,30 +53,30 @@ module internal NoteworthyParamInfoLocationsImpl = let digOutIdentFromStaticArg synType = match synType with - | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id],_)),_,_) -> Some id.idText - | SynType.LongIdent(LongIdentWithDots([id],_)) -> Some id.idText // NOTE: again, not a static constant, but may be a prefix of a Named in incomplete code + | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id], _)), _, _) -> Some id.idText + | SynType.LongIdent(LongIdentWithDots([id], _)) -> Some id.idText // NOTE: again, not a static constant, but may be a prefix of a Named in incomplete code | _ -> None let getNamedParamName e = match e with // f(x=4) - | SynExpr.App(ExprAtomicFlag.NonAtomic, _, - SynExpr.App(ExprAtomicFlag.NonAtomic, true, + | SynExpr.App(ExprAtomicFlag.NonAtomic, _, + SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.Ident op, SynExpr.Ident n, - _range), + _range), _, _) when op.idText="op_Equality" -> Some n.idText // f(?x=4) - | SynExpr.App(ExprAtomicFlag.NonAtomic, _, - SynExpr.App(ExprAtomicFlag.NonAtomic, true, + | SynExpr.App(ExprAtomicFlag.NonAtomic, _, + SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.Ident op, - SynExpr.LongIdent(true(*isOptional*),LongIdentWithDots([n],_),_ref,_lidrange), _range), + SynExpr.LongIdent(true(*isOptional*), LongIdentWithDots([n], _), _ref, _lidrange), _range), _, _) when op.idText="op_Equality" -> Some n.idText | _ -> None let getTypeName(synType) = match synType with - | SynType.LongIdent(LongIdentWithDots(ids,_)) -> ids |> pathOfLid + | SynType.LongIdent(LongIdentWithDots(ids, _)) -> ids |> pathOfLid | _ -> [""] // TODO type name for other cases, see also unit test named "ParameterInfo.LocationOfParams.AfterQuicklyTyping.CallConstructorViaLongId.Bug94333" let handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt : _ option) = @@ -101,19 +101,19 @@ module internal NoteworthyParamInfoLocationsImpl = match inner with | None -> if AstTraversal.rangeContainsPosEdgesExclusive parenRange pos then - let commasAndCloseParen = ((synExprList,commaRanges@[parenRange]) ||> List.map2 (fun e c -> c.End, getNamedParamName e)) + let commasAndCloseParen = ((synExprList, commaRanges@[parenRange]) ||> List.map2 (fun e c -> c.End, getNamedParamName e)) let r = Found (parenRange.Start, commasAndCloseParen, rpRangeOpt.IsSome) r, None else NotFound, None | _ -> NotFound, None - | SynExprParen(SynExprParen(SynExpr.Tuple(_,_,_),_,_,_) as synExpr, _, rpRangeOpt, parenRange) -> // f((x,y)) is special, single tuple arg - handleSingleArg traverseSynExpr (pos,synExpr,parenRange,rpRangeOpt) + | SynExprParen(SynExprParen(SynExpr.Tuple(_, _, _), _, _, _) as synExpr, _, rpRangeOpt, parenRange) -> // f((x, y)) is special, single tuple arg + handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt) // dig into multiple parens - | SynExprParen(SynExprParen(_,_,_,_) as synExpr, _, _, _parenRange) -> - let r,_cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr + | SynExprParen(SynExprParen(_, _, _, _) as synExpr, _, _, _parenRange) -> + let r, _cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr r, None | SynExprParen(synExpr, _lpRange, rpRangeOpt, parenRange) -> // single argument @@ -146,18 +146,18 @@ module internal NoteworthyParamInfoLocationsImpl = - let traverseInput(pos,parseTree) = + let traverseInput(pos, parseTree) = - AstTraversal.Traverse(pos,parseTree, { new AstTraversal.AstVisitorBase<_>() with + AstTraversal.Traverse(pos, parseTree, { new AstTraversal.AstVisitorBase<_>() with member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debug locals match expr with - // new LID(...) and error recovery of these + // new LID(...) and error recovery of these | SynExpr.New(_, synType, synExpr, _range) -> - let constrArgsResult,cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr - match constrArgsResult,cacheOpt with - | Found(parenLoc,args,isThereACloseParen), _ -> + let constrArgsResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr + match constrArgsResult, cacheOpt with + | Found(parenLoc, args, isThereACloseParen), _ -> let typeName = getTypeName synType Some (FSharpNoteworthyParamInfoLocations(typeName, synType.Range, parenLoc, args |> List.map fst, isThereACloseParen, args |> List.map snd)) | NotFound, Some cache -> @@ -176,7 +176,7 @@ module internal NoteworthyParamInfoLocationsImpl = if AstTraversal.rangeContainsPosEdgesExclusive typeArgsm pos then // We found it, dig out ident match digOutIdentFromFuncExpr synExpr with - | Some(lid,lidRange) -> Some (FSharpNoteworthyParamInfoLocations(lid, lidRange, op.idRange.Start, [ wholem.End ], false, [])) + | Some(lid, lidRange) -> Some (FSharpNoteworthyParamInfoLocations(lid, lidRange, op.idRange.Start, [ wholem.End ], false, [])) | None -> None else None @@ -189,12 +189,12 @@ module internal NoteworthyParamInfoLocationsImpl = | Some _ -> fResult | _ -> // Search the argument - let xResult,cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr2 - match xResult,cacheOpt with - | Found(parenLoc,args,isThereACloseParen),_ -> + let xResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr2 + match xResult, cacheOpt with + | Found(parenLoc, args, isThereACloseParen), _ -> // We found it, dig out ident match digOutIdentFromFuncExpr synExpr with - | Some(lid,lidRange) -> + | Some(lid, lidRange) -> assert(isInfix = (posLt parenLoc lidRange.End)) if isInfix then // This seems to be an infix operator, since the start of the argument is a position earlier than the end of the long-id being applied to it. @@ -206,7 +206,7 @@ module internal NoteworthyParamInfoLocationsImpl = | NotFound, Some cache -> cache | _ -> traverseSynExpr synExpr2 - // ID and error recovery of these + // ID and error recovery of these | SynExpr.TypeApp(synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> match traverseSynExpr synExpr with | Some _ as r -> r @@ -221,9 +221,9 @@ module internal NoteworthyParamInfoLocationsImpl = | _ -> defaultTraverse expr - member this.VisitTypeAbbrev(tyAbbrevRhs,_m) = + member this.VisitTypeAbbrev(tyAbbrevRhs, _m) = match tyAbbrevRhs with - | SynType.App(SynType.LongIdent(LongIdentWithDots(lid,_) as lidwd), Some(openm), args, commas, closemOpt, _pf, wholem) -> + | SynType.App(SynType.LongIdent(LongIdentWithDots(lid, _) as lidwd), Some(openm), args, commas, closemOpt, _pf, wholem) -> let lidm = lidwd.Range let betweenTheBrackets = mkRange wholem.FileName openm.Start wholem.End if AstTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos && args |> List.forall isStaticArg then @@ -241,9 +241,9 @@ module internal NoteworthyParamInfoLocationsImpl = let inheritm = mkRange m.FileName m.Start m.End if AstTraversal.rangeContainsPosEdgesExclusive inheritm pos then // inherit ty(expr) --- treat it like an application (constructor call) - let xResult,_cacheOpt = searchSynArgExpr defaultTraverse pos expr + let xResult, _cacheOpt = searchSynArgExpr defaultTraverse pos expr match xResult with - | Found(parenLoc,args,isThereACloseParen) -> + | Found(parenLoc, args, isThereACloseParen) -> // we found it, dig out ident let typeName = getTypeName ty let r = FSharpNoteworthyParamInfoLocations(typeName, ty.Range, parenLoc, args |> List.map fst, isThereACloseParen, args |> List.map snd) @@ -253,12 +253,12 @@ module internal NoteworthyParamInfoLocationsImpl = }) type FSharpNoteworthyParamInfoLocations with - static member Find(pos,parseTree) = - match traverseInput(pos,parseTree) with + static member Find(pos, parseTree) = + match traverseInput(pos, parseTree) with | Some nwpl as r -> #if DEBUG let ranges = nwpl.LongIdStartLocation :: nwpl.LongIdEndLocation :: nwpl.OpenParenLocation :: (nwpl.TupleEndLocations |> Array.toList) - let sorted = ranges |> List.sortWith (fun a b -> posOrder.Compare(a,b)) |> Seq.toList + let sorted = ranges |> List.sortWith (fun a b -> posOrder.Compare(a, b)) |> Seq.toList assert(ranges = sorted) #else ignore nwpl diff --git a/src/fsharp/vs/ServiceParamInfoLocations.fsi b/src/fsharp/vs/ServiceParamInfoLocations.fsi index 137ae4ad9c..d72e6330b7 100755 --- a/src/fsharp/vs/ServiceParamInfoLocations.fsi +++ b/src/fsharp/vs/ServiceParamInfoLocations.fsi @@ -10,22 +10,35 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range +/// Represents the locations relevant to activating parameter info in an IDE [] #if COMPILER_PUBLIC_API type FSharpNoteworthyParamInfoLocations = #else type internal FSharpNoteworthyParamInfoLocations = #endif + + /// The text of the long identifier prior to the open-parentheses member LongId : string list + + /// The start location of long identifier prior to the open-parentheses member LongIdStartLocation : pos + + /// The end location of long identifier prior to the open-parentheses member LongIdEndLocation : pos + + /// The location of the open-parentheses member OpenParenLocation : pos - /// locations of commas and close parenthesis (or, last char of last arg, if no final close parenthesis) + + /// The locations of commas and close parenthesis (or, last char of last arg, if no final close parenthesis) member TupleEndLocations : pos[] - /// false if either this is a call without parens "f x" or the parser recovered as in "f(x,y" + + /// Is false if either this is a call without parens "f x" or the parser recovered as in "f(x,y" member IsThereACloseParen : bool - /// empty or a name if an actual named parameter; f(0,a=4,?b=None) would be [|None; Some "a"; Some "b"|] + + /// Either empty or a name if an actual named parameter; f(0,a=4,?b=None) would be [|None; Some "a"; Some "b"|] member NamedParamNames : string option [] + /// Find the information about parameter info locations at a particular source location static member Find : pos * Ast.ParsedInput -> FSharpNoteworthyParamInfoLocations option diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index e64e5da8c3..c5e30bf3df 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -85,7 +85,7 @@ type CompletionContext = //---------------------------------------------------------------------------- [] -type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput option, parseHadErrors : bool, dependencyFiles : string list) = +type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput option, parseHadErrors: bool, dependencyFiles: string[]) = member scope.Errors = errors @@ -382,7 +382,7 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput /// When these files appear or disappear the configuration for the current project is invalidated. member scope.DependencyFiles = dependencyFiles - + member scope.FileName = match input with | Some(ParsedInput.ImplFile(ParsedImplFileInput(fileName = modname))) diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi index d766e6fb56..9a2c8379d5 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fsi +++ b/src/fsharp/vs/ServiceUntypedParse.fsi @@ -37,7 +37,7 @@ type internal FSharpParseFileResults = member ValidateBreakpointLocation : pos:pos -> range option /// When these files change then the build is invalid - member DependencyFiles : string list + member DependencyFiles : string[] /// Get the errors and warnings for the parse member Errors : FSharpErrorInfo[] @@ -45,7 +45,7 @@ type internal FSharpParseFileResults = /// Indicates if any errors occurred during the parse member ParseHadErrors : bool - internal new : errors : FSharpErrorInfo[] * input : Ast.ParsedInput option * parseHadErrors : bool * dependencyFiles : string list -> FSharpParseFileResults + internal new: errors: FSharpErrorInfo[] * input: Ast.ParsedInput option * parseHadErrors: bool * dependencyFiles: string[] -> FSharpParseFileResults /// Information about F# source file names #if COMPILER_PUBLIC_API diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index f8e1dac2df..5c2fc8f544 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -24,6 +24,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AccessibilityLogic open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.CompileOps +open Microsoft.FSharp.Compiler.CompileOptions open Microsoft.FSharp.Compiler.Driver open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Lib @@ -53,11 +54,11 @@ type internal Layout = StructuredFormat.Layout [] module EnvMisc = - let getToolTipTextSize = GetEnvInteger "FCS_RecentForegroundTypeCheckCacheSize" 5 + let getToolTipTextSize = GetEnvInteger "FCS_GetToolTipTextCacheSize" 5 let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 let braceMatchCacheSize = GetEnvInteger "FCS_BraceMatchCacheSize" 5 - let parseFileInProjectCacheSize = GetEnvInteger "FCS_ParseFileInProjectCacheSize" 2 - let incrementalTypeCheckCacheSize = GetEnvInteger "FCS_IncrementalTypeCheckCacheSize" 5 + let parseFileCacheSize = GetEnvInteger "FCS_ParseFileCacheSize" 2 + let checkFileInProjectCacheSize = GetEnvInteger "FCS_CheckFileInProjectCacheSize" 5 let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 @@ -163,7 +164,8 @@ type TypeCheckInfo loadClosure : LoadClosure option, reactorOps : IReactorOperations, checkAlive : (unit -> bool), - textSnapshotInfo:obj option) = + textSnapshotInfo:obj option, + implementationFiles: TypedImplFile list) = let textSnapshotInfo = defaultArg textSnapshotInfo null let (|CNR|) (cnr:CapturedNameResolution) = @@ -1356,9 +1358,52 @@ type TypeCheckInfo /// The assembly being analyzed member __.ThisCcu = thisCcu + member __.ImplementationFiles = implementationFiles + override __.ToString() = "TypeCheckInfo(" + mainInputFileName + ")" +type FSharpParsingOptions = + { + SourceFiles: string [] + ConditionalCompilationDefines: string list + ErrorSeverityOptions: FSharpErrorSeverityOptions + LightSyntax: bool option + CompilingFsLib: bool + IsExe: bool + } + + member x.LastFileName = + Debug.Assert(not (Array.isEmpty x.SourceFiles), "Parsing options don't contain any file") + Array.last x.SourceFiles + + static member Default = + { SourceFiles = Array.empty + ConditionalCompilationDefines = [] + ErrorSeverityOptions = FSharpErrorSeverityOptions.Default + LightSyntax = None + CompilingFsLib = false + IsExe = false + } + + static member FromTcConfig(tcConfig: TcConfig, sourceFiles) = + { + SourceFiles = sourceFiles + ConditionalCompilationDefines = tcConfig.conditionalCompilationDefines + ErrorSeverityOptions = tcConfig.errorSeverityOptions + LightSyntax = tcConfig.light + CompilingFsLib = tcConfig.compilingFslib + IsExe = tcConfig.target.IsExe + } + static member FromTcConfigBuidler(tcConfigB: TcConfigBuilder, sourceFiles) = + { + SourceFiles = sourceFiles + ConditionalCompilationDefines = tcConfigB.conditionalCompilationDefines + ErrorSeverityOptions = tcConfigB.errorSeverityOptions + LightSyntax = tcConfigB.light + CompilingFsLib = tcConfigB.compilingFslib + IsExe = tcConfigB.target.IsExe + } module internal Parser = @@ -1372,153 +1417,127 @@ module internal Parser = /// Error handler for parsing & type checking while processing a single file - type ErrorHandler(reportErrors, mainInputFileName, tcConfig: TcConfig, source: string) = - let mutable tcConfig = tcConfig + type ErrorHandler(reportErrors, mainInputFileName, errorSeverityOptions: FSharpErrorSeverityOptions, source) = + let mutable options = errorSeverityOptions let errorsAndWarningsCollector = new ResizeArray<_>() let mutable errorCount = 0 - + // We'll need number of lines for adjusting error messages at EOF let fileInfo = GetFileInfoForLastLineErrors source - + // This function gets called whenever an error happens during parsing or checking - let diagnosticSink sev (exn:PhasedDiagnostic) = + let diagnosticSink sev (exn: PhasedDiagnostic) = // Sanity check here. The phase of an error should be in a phase known to the language service. let exn = if not(exn.IsPhaseInCompile()) then // Reaching this point means that the error would be sticky if we let it prop up to the language service. // Assert and recover by replacing phase with one known to the language service. Trace.TraceInformation(sprintf "The subcategory '%s' seen in an error should not be seen by the language service" (exn.Subcategory())) - {exn with Phase=BuildPhase.TypeCheck} + { exn with Phase = BuildPhase.TypeCheck } else exn - if reportErrors then - let report exn = - for ei in ErrorHelpers.ReportError (tcConfig, false, mainInputFileName, fileInfo, (exn, sev)) do + if reportErrors then + let report exn = + for ei in ErrorHelpers.ReportError (options, false, mainInputFileName, fileInfo, (exn, sev)) do errorsAndWarningsCollector.Add ei - if sev = FSharpErrorSeverity.Error then + if sev = FSharpErrorSeverity.Error then errorCount <- errorCount + 1 - + match exn with #if EXTENSIONTYPING - | {Exception = (:? TypeProviderError as tpe)} -> - tpe.Iter (fun e -> - let newExn = {exn with Exception = e} - report newExn - ) + | { Exception = (:? TypeProviderError as tpe) } -> tpe.Iter(fun e -> report { exn with Exception = e }) #endif | e -> report e - - let errorLogger = - { new ErrorLogger("ErrorHandler") with + + let errorLogger = + { new ErrorLogger("ErrorHandler") with member x.DiagnosticSink (exn, isError) = diagnosticSink (if isError then FSharpErrorSeverity.Error else FSharpErrorSeverity.Warning) exn member x.ErrorCount = errorCount } - - + // Public members member x.ErrorLogger = errorLogger member x.CollectedDiagnostics = errorsAndWarningsCollector.ToArray() member x.ErrorCount = errorCount - member x.TcConfig with set tc = tcConfig <- tc + member x.ErrorSeverityOptions with set opts = options <- opts member x.AnyErrors = errorCount > 0 + let getLightSyntaxStatus fileName options = + let lower = String.lowercase fileName + let lightOnByDefault = List.exists (Filename.checkSuffix lower) FSharpLightSyntaxFileSuffixes + let lightSyntaxStatus = if lightOnByDefault then (options.LightSyntax <> Some false) else (options.LightSyntax = Some true) + LightSyntaxStatus(lightSyntaxStatus, true) - /// ParseOneFile builds all the information necessary to report errors, match braces and build scopes - /// - /// projectSourceFiles is only used to compute isLastCompiland, and is ignored if Build.IsScript(mainInputFileName) is true. - let ParseOneFile (ctok, source: string, matchBracesOnly: bool, reportErrors: bool, mainInputFileName: string, projectSourceFiles: string list, tcConfig: TcConfig) = - - // This function requires the compilation thread because we install error handlers, whose callbacks must - // be invoked on the compilation thread, no other reason known to date. - // We should check whether those are "real" reasons - we could for example make collecting errors thread safe. - RequireCompilationThread ctok - - // Initialize the error handler - let errHandler = new ErrorHandler(reportErrors, mainInputFileName, tcConfig, source) + let createLexerFunction fileName options lexbuf (errHandler: ErrorHandler) = + let lightSyntaxStatus = getLightSyntaxStatus fileName options - // Adding this new-line character at the end of the source seems odd but is required for some unit tests - let source = if source.Length = 0 || not (source.[source.Length - 1] = '\n') then source + "\n" else source - let lexbuf = UnicodeLexing.StringAsLexbuf source + // If we're editing a script then we define INTERACTIVE otherwise COMPILED. + // Since this parsing for intellisense we always define EDITING. + let defines = SourceFileImpl.AdditionalDefinesForUseInEditor(fileName) @ options.ConditionalCompilationDefines - // Collector for parens matching - let matchPairRef = new ResizeArray<_>() - - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) - use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - - // Errors on while parsing project arguments - - let parseResult = - - // If we're editing a script then we define INTERACTIVE otherwise COMPILED. Since this parsing for intellisense we always - // define EDITING - let conditionalCompilationDefines = - SourceFileImpl.AdditionalDefinesForUseInEditor(mainInputFileName) @ tcConfig.conditionalCompilationDefines + // Note: we don't really attempt to intern strings across a large scope. + let lexResourceManager = new Lexhelp.LexResourceManager() - let lightSyntaxStatusInital = tcConfig.ComputeLightSyntaxInitialStatus (mainInputFileName) - let lightSyntaxStatus = LightSyntaxStatus(lightSyntaxStatusInital,true) - - // Note: we don't really attempt to intern strings across a large scope - let lexResourceManager = new Lexhelp.LexResourceManager() - let lexargs = mkLexargs(mainInputFileName, - conditionalCompilationDefines, - lightSyntaxStatus, - lexResourceManager, - ref [], - errHandler.ErrorLogger) - - // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. - let lexargs = { lexargs with applyLineDirectives=false } - - Lexhelp.usingLexbufForParsing (lexbuf, mainInputFileName) (fun lexbuf -> - try - let skip = true - let tokenizer = LexFilter.LexFilter (lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) - let lexfun = tokenizer.Lexer - if matchBracesOnly then - // Quick bracket matching parse - let parenTokensBalance t1 t2 = - match t1,t2 with - | (LPAREN,RPAREN) - | (LPAREN,RPAREN_IS_HERE) - | (LBRACE,RBRACE) - | (LBRACE,RBRACE_IS_HERE) - | (SIG,END) - | (STRUCT,END) - | (LBRACK_BAR,BAR_RBRACK) - | (LBRACK,RBRACK) - | (LBRACK_LESS,GREATER_RBRACK) - | (BEGIN,END) -> true - | (LQUOTE q1,RQUOTE q2) when q1 = q2 -> true - | _ -> false - let rec matchBraces stack = - match lexfun lexbuf,stack with - | tok2,((tok1,m1) :: stack') when parenTokensBalance tok1 tok2-> - if matchBracesOnly then - matchPairRef.Add (m1, lexbuf.LexemeRange) - matchBraces stack' - | ((LPAREN | LBRACE | LBRACK | LBRACK_BAR | LQUOTE _ | LBRACK_LESS) as tok),_ -> matchBraces ((tok,lexbuf.LexemeRange) :: stack) - | (EOF _ | LEX_FAILURE _),_ -> () - | _ -> matchBraces stack - - matchBraces [] - None - else - let isLastCompiland = - projectSourceFiles.Length >= 1 && - System.String.Compare(projectSourceFiles.[projectSourceFiles.Length-1],mainInputFileName,StringComparison.CurrentCultureIgnoreCase)=0 - let isLastCompiland = isLastCompiland || CompileOps.IsScript(mainInputFileName) - let isExe = tcConfig.target.IsExe - let parseResult = ParseInput(lexfun,errHandler.ErrorLogger,lexbuf,None,mainInputFileName,(isLastCompiland,isExe)) - Some parseResult - with e -> + // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. + let lexargs = mkLexargs(fileName, defines, lightSyntaxStatus, lexResourceManager, ref [], errHandler.ErrorLogger) + let lexargs = { lexargs with applyLineDirectives = false } + + let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) + tokenizer.Lexer + + // Adding this new-line character at the end of the source seems odd but is required for some unit tests + // Todo: fix tests + let addNewLine (source: string) = + if source.Length = 0 || not (source.[source.Length - 1] = '\n') then source + "\n" else source + + let matchBraces(source, fileName, options: FSharpParsingOptions, userOpName: string) = + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) + let matchingBraces = new ResizeArray<_>() + Lexhelp.usingLexbufForParsing(UnicodeLexing.StringAsLexbuf(addNewLine source), fileName) (fun lexbuf -> + let errHandler = ErrorHandler(false, fileName, options.ErrorSeverityOptions, source) + let lexfun = createLexerFunction fileName options lexbuf errHandler + let parenTokensBalance t1 t2 = + match t1, t2 with + | (LPAREN, RPAREN) + | (LPAREN, RPAREN_IS_HERE) + | (LBRACE, RBRACE) + | (LBRACE, RBRACE_IS_HERE) + | (SIG, END) + | (STRUCT, END) + | (LBRACK_BAR, BAR_RBRACK) + | (LBRACK, RBRACK) + | (LBRACK_LESS, GREATER_RBRACK) + | (BEGIN, END) -> true + | (LQUOTE q1, RQUOTE q2) -> q1 = q2 + | _ -> false + let rec matchBraces stack = + match lexfun lexbuf, stack with + | tok2, ((tok1, m1) :: stack') when parenTokensBalance tok1 tok2 -> + matchingBraces.Add(m1, lexbuf.LexemeRange) + matchBraces stack' + | ((LPAREN | LBRACE | LBRACK | LBRACK_BAR | LQUOTE _ | LBRACK_LESS) as tok), _ -> + matchBraces ((tok, lexbuf.LexemeRange) :: stack) + | (EOF _ | LEX_FAILURE _), _ -> () + | _ -> matchBraces stack + matchBraces []) + matchingBraces.ToArray() + + let parseFile(source, fileName, options: FSharpParsingOptions, userOpName: string) = + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) + let errHandler = new ErrorHandler(true, fileName, options.ErrorSeverityOptions, source) + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) + use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + + let parseResult = + Lexhelp.usingLexbufForParsing(UnicodeLexing.StringAsLexbuf(addNewLine source), fileName) (fun lexbuf -> + let lexfun = createLexerFunction fileName options lexbuf errHandler + let isLastCompiland = + fileName.Equals(options.LastFileName, StringComparison.CurrentCultureIgnoreCase) || + CompileOps.IsScript(fileName) + let isExe = options.IsExe + try Some (ParseInput(lexfun, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe))) + with e -> errHandler.ErrorLogger.ErrorR(e) None) - - - errHandler.CollectedDiagnostics, - matchPairRef.ToArray(), - parseResult, - errHandler.AnyErrors - + errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors /// Indicates if the type check got aborted because it is no longer relevant. type TypeCheckAborted = Yes | No of TypeCheckInfo @@ -1550,7 +1569,7 @@ module internal Parser = // Run the type checker... | Some parsedMainInput -> // Initialize the error handler - let errHandler = new ErrorHandler(true, mainInputFileName, tcConfig, source) + let errHandler = new ErrorHandler(true, mainInputFileName, tcConfig.errorSeverityOptions, source) use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck @@ -1559,7 +1578,7 @@ module internal Parser = let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) // update the error handler with the modified tcConfig - errHandler.TcConfig <- tcConfig + errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions // Play background errors and warnings for this file. for (err,sev) in backgroundDiagnostics do @@ -1662,7 +1681,7 @@ module internal Parser = let errors = errHandler.CollectedDiagnostics match tcEnvAtEndOpt with - | Some (tcEnvAtEnd, _typedImplFiles, tcState) -> + | Some (tcEnvAtEnd, typedImplFiles, tcState) -> let scope = TypeCheckInfo(tcConfig, tcGlobals, tcState.PartialAssemblySignature, @@ -1678,7 +1697,8 @@ module internal Parser = loadClosure, reactorOps, checkAlive, - textSnapshotInfo) + textSnapshotInfo, + typedImplFiles) return errors, TypeCheckAborted.No scope | None -> return errors, TypeCheckAborted.Yes @@ -1706,15 +1726,6 @@ type FSharpProjectOptions = static member UseSameProjectFileName(options1,options2) = options1.ProjectFileName = options2.ProjectFileName - /// Compare two options sets with respect to the parts of the options that are important to parsing. - static member AreSameForParsing(options1,options2) = - match options1.Stamp, options2.Stamp with - | Some x, Some y -> (x = y) - | _ -> - options1.ProjectFileName = options2.ProjectFileName && - options1.OtherOptions = options2.OtherOptions && - options1.UnresolvedReferences = options2.UnresolvedReferences - /// Compare two options sets with respect to the parts of the options that are important to building. static member AreSameForChecking(options1,options2) = match options1.Stamp, options2.Stamp with @@ -1745,7 +1756,7 @@ 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, keepAssemblyContents, errors: FSharpErrorInfo[], details:(TcGlobals*TcImports*CcuThunk*ModuleOrNamespaceType*TcSymbolUses list*TopAttribs option*CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string list) option, _reactorOps: IReactorOperations) = +type FSharpCheckProjectResults(projectFileName:string, keepAssemblyContents, errors: FSharpErrorInfo[], details:(TcGlobals*TcImports*CcuThunk*ModuleOrNamespaceType*TcSymbolUses list*TopAttribs option*CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option, _reactorOps: IReactorOperations) = let getDetails() = match details with @@ -1761,7 +1772,7 @@ type FSharpCheckProjectResults(projectFileName:string, keepAssemblyContents, err FSharpAssemblySignature(tcGlobals, thisCcu, tcImports, topAttribs, ccuSig) member info.AssemblyContents = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" + 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 @@ -1817,7 +1828,7 @@ type FSharpCheckProjectResults(projectFileName:string, keepAssemblyContents, err // // There is an important property of all the objects returned by the methods of this type: they do not require // the corresponding background builder to be alive. That is, they are simply plain-old-data through pre-formatting of all result text. -type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo option, dependencyFiles: string list, builderX: IncrementalBuilder option, reactorOpsX:IReactorOperations) = +type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo option, dependencyFiles: string[], builderX: IncrementalBuilder option, reactorOpsX:IReactorOperations, keepAssemblyContents: bool) = // This may be None initially, or may be set to None when the object is disposed or finalized let mutable details = match scopeOptX with None -> None | Some scopeX -> Some (scopeX, builderX, reactorOpsX) @@ -2002,6 +2013,12 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp RequireCompilationThread ctok scope.IsRelativeNameResolvable(pos, plid, item)) + member info.ImplementationFiles = + 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) + [ for mimpl in scope.ImplementationFiles -> FSharpImplementationFileContents(cenv, mimpl)]) override info.ToString() = "FSharpCheckFileResults(" + filename + ")" @@ -2038,10 +2055,11 @@ module Helpers = && FSharpProjectOptions.UseSameProjectFileName(o1,o2) /// Determine whether two (fileName,sourceText,options) keys should be identical w.r.t. parsing - let AreSameForParsing3((fileName1: string, source1: string, options1: FSharpProjectOptions), (fileName2, source2, options2)) = - (fileName1 = fileName2) - && FSharpProjectOptions.AreSameForParsing(options1,options2) - && (source1 = source2) + let AreSameForParsing((fileName1: string, source1: string, options1), (fileName2, source2, options2)) = + fileName1 = fileName2 && options1 = options2 && source1 = source2 + + let AreSimilarForParsing((fileName1, _, _), (fileName2, _, _)) = + fileName1 = fileName2 /// Determine whether two (fileName,sourceText,options) keys should be identical w.r.t. checking let AreSameForChecking3((fileName1: string, source1: string, options1: FSharpProjectOptions), (fileName2, source2, options2)) = @@ -2289,29 +2307,26 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. - let parseFileInProjectCache = - MruCache(parseFileInProjectCacheSize, - areSame=AreSameForParsing3, - areSimilar=AreSubsumable3) + let parseFileCache = MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseAndCheckFileInProjectCachePossiblyStale - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseAndCheckFileInProjectCache + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCachePossiblyStale + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache // /// Cache which holds recently seen type-checks. /// This cache may hold out-of-date entries, in two senses /// - there may be a more recent antecedent state available because the background build has made it available /// - the source for the file may have changed - let parseAndCheckFileInProjectCachePossiblyStale = + let checkFileInProjectCachePossiblyStale = MruCache - (keepStrongly=incrementalTypeCheckCacheSize, + (keepStrongly=checkFileInProjectCacheSize, areSame=AreSameForChecking2, areSimilar=AreSubsumable2) // Also keyed on source. This can only be out of date if the antecedent is out of date - let parseAndCheckFileInProjectCache = + let checkFileInProjectCache = MruCache - (keepStrongly=incrementalTypeCheckCacheSize, + (keepStrongly=checkFileInProjectCacheSize, areSame=AreSameForChecking3, areSimilar=AreSubsumable3) @@ -2326,7 +2341,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC static let mutable foregroundTypeCheckCount = 0 let MakeCheckFileResultsEmpty(filename, creationErrors) = - FSharpCheckFileResults (filename, Array.ofList creationErrors, None, [], None, reactorOps) + FSharpCheckFileResults (filename, Array.ofList creationErrors, None, [| |], None, reactorOps, keepAssemblyContents) let MakeCheckFileResults(filename, options:FSharpProjectOptions, builder, scope, dependencyFiles, creationErrors, parseErrors, tcErrors) = let errors = @@ -2337,64 +2352,39 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC else yield! tcErrors |] - FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, Some builder, reactorOps) + FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, Some builder, reactorOps, keepAssemblyContents) let MakeCheckFileAnswer(filename, tcFileResult, options:FSharpProjectOptions, builder, dependencyFiles, creationErrors, parseErrors, tcErrors) = match tcFileResult with | Parser.TypeCheckAborted.Yes -> FSharpCheckFileAnswer.Aborted | Parser.TypeCheckAborted.No scope -> FSharpCheckFileAnswer.Succeeded(MakeCheckFileResults(filename, options, builder, scope, dependencyFiles, creationErrors, parseErrors, tcErrors)) - member bc.RecordTypeCheckFileInProjectResults(filename,options,parseResults,fileVersion,priorTimeStamp,checkAnswer,source) = + member bc.RecordTypeCheckFileInProjectResults(filename,options,parsingOptions,parseResults,fileVersion,priorTimeStamp,checkAnswer,source) = match checkAnswer with | None | Some FSharpCheckFileAnswer.Aborted -> () | Some (FSharpCheckFileAnswer.Succeeded typedResults) -> foregroundTypeCheckCount <- foregroundTypeCheckCount + 1 parseCacheLock.AcquireLock (fun ltok -> - parseAndCheckFileInProjectCachePossiblyStale.Set(ltok, (filename,options),(parseResults,typedResults,fileVersion)) - parseAndCheckFileInProjectCache.Set(ltok, (filename,source,options),(parseResults,typedResults,fileVersion,priorTimeStamp)) - parseFileInProjectCache.Set(ltok, (filename,source,options),parseResults)) + checkFileInProjectCachePossiblyStale.Set(ltok, (filename,options),(parseResults,typedResults,fileVersion)) + checkFileInProjectCache.Set(ltok, (filename,source,options),(parseResults,typedResults,fileVersion,priorTimeStamp)) + parseFileCache.Set(ltok, (filename, source, parsingOptions), parseResults)) member bc.ImplicitlyStartCheckProjectInBackground(options, userOpName) = if implicitlyStartBackgroundWork then bc.CheckProjectInBackground(options, userOpName + ".ImplicitlyStartCheckProjectInBackground") - /// Parses the source file and returns untyped AST - member bc.ParseFileInProject(filename:string, source,options:FSharpProjectOptions, userOpName) = - match parseCacheLock.AcquireLock (fun ctok -> parseFileInProjectCache.TryGet (ctok, (filename, source, options))) with - | Some parseResults -> async.Return parseResults - | None -> - // Try this cache too (which might contain different entries) - let cachedResults = parseCacheLock.AcquireLock (fun ctok -> parseAndCheckFileInProjectCache.TryGet(ctok,(filename,source,options))) - match cachedResults with - | Some (parseResults, _checkResults,_,_) -> async.Return parseResults - | _ -> - reactor.EnqueueAndAwaitOpAsync(userOpName, "ParseFileInProject", filename, fun ctok -> - cancellable { - // Try the caches again - it may have been filled by the time this operation runs - match parseCacheLock.AcquireLock (fun ctok -> parseFileInProjectCache.TryGet (ctok, (filename, source, options))) with - | Some parseResults -> return parseResults - | None -> - let cachedResults = parseCacheLock.AcquireLock (fun ctok -> parseAndCheckFileInProjectCache.TryGet(ctok, (filename,source,options))) - match cachedResults with - | Some (parseResults, _checkResults,_,_) -> return parseResults - | _ -> - Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "ParseFileInProject.CacheMiss", filename) - foregroundParseCount <- foregroundParseCount + 1 - let! builderOpt,creationErrors,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) - use _unwind = decrement - match builderOpt with - | None -> return FSharpParseFileResults(List.toArray creationErrors, None, true, []) - | Some builder -> - // Do the parsing. - let parseErrors, _matchPairs, inputOpt, anyErrors = - Parser.ParseOneFile (ctok, source, false, true, filename, builder.SourceFiles, builder.TcConfig) - - let res = FSharpParseFileResults(parseErrors, inputOpt, anyErrors, builder.AllDependenciesDeprecated ) - parseCacheLock.AcquireLock (fun ctok -> parseFileInProjectCache.Set (ctok, (filename, source, options), res)) - return res - } - ) + member bc.ParseFile(filename: string, source: string, options: FSharpParsingOptions, userOpName: string) = + async { + match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (filename, source, options))) with + | Some res -> return res + | None -> + foregroundParseCount <- foregroundParseCount + 1 + let parseErrors, inputOpt, anyErrors = Parser.parseFile(source, filename, options, userOpName) + let res = FSharpParseFileResults(parseErrors, inputOpt, anyErrors, options.SourceFiles) + parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (filename, source, options), res)) + return res + } /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member bc.GetBackgroundParseResultsForFileInProject(filename, options, userOpName) = @@ -2403,32 +2393,17 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let! builderOpt, creationErrors, decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) use _unwind = decrement match builderOpt with - | None -> return FSharpParseFileResults(List.toArray creationErrors, None, true, []) + | None -> return FSharpParseFileResults(List.toArray creationErrors, None, true, [| |]) | Some builder -> let! inputOpt,_,_,parseErrors = builder.GetParseResultsForFile (ctok, filename) - let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (builder.TcConfig, false, filename, parseErrors) |] + let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (builder.TcConfig.errorSeverityOptions, false, filename, parseErrors) |] return FSharpParseFileResults(errors = errors, input = inputOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) } ) - member bc.MatchBraces(filename:string, source, options, userOpName) = - reactor.EnqueueAndAwaitOpAsync(userOpName, "MatchBraces", filename, fun ctok -> - cancellable { - let! builderOpt,_,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) - use _unwind = decrement - match builderOpt with - | None -> return [| |] - | Some builder -> - let _parseErrors, matchPairs, _inputOpt, _anyErrors = - Parser.ParseOneFile (ctok, source, true, false, filename, builder.SourceFiles, builder.TcConfig) - - return matchPairs - } - ) - member bc.GetCachedCheckFileResult(builder: IncrementalBuilder,filename,source,options) = // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date - let cachedResults = parseCacheLock.AcquireLock (fun ltok -> parseAndCheckFileInProjectCache.TryGet(ltok, (filename,source,options))) + let cachedResults = parseCacheLock.AcquireLock (fun ltok -> checkFileInProjectCache.TryGet(ltok, (filename,source,options))) match cachedResults with // | Some (parseResults, checkResults, _, _) when builder.AreCheckResultsBeforeFileInProjectReady(filename) -> @@ -2486,8 +2461,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let! tcErrors, tcFileResult = Parser.CheckOneFile(parseResults, source, fileName, options.ProjectFileName, tcPrior.TcConfig, tcPrior.TcGlobals, tcPrior.TcImports, tcPrior.TcState, loadClosure, tcPrior.Errors, reactorOps, (fun () -> builder.IsAlive), textSnapshotInfo, userOpName) - let checkAnswer = MakeCheckFileAnswer(fileName, tcFileResult, options, builder, tcPrior.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) - bc.RecordTypeCheckFileInProjectResults(fileName, options, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, source) + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcPrior.TcConfig, Array.ofList builder.SourceFiles) + let checkAnswer = MakeCheckFileAnswer(fileName, tcFileResult, options, builder, Array.ofList tcPrior.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) + bc.RecordTypeCheckFileInProjectResults(fileName, options, parsingOptions, parseResults, fileVersion, tcPrior.TimeStamp, Some checkAnswer, source) return checkAnswer finally let dummy = ref () @@ -2504,20 +2480,25 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. member bc.CheckFileInProjectAllowingStaleCachedResults(parseResults: FSharpParseFileResults, filename, fileVersion, source, options, textSnapshotInfo: obj option, userOpName) = - let execWithReactorAsync action = reactor.EnqueueAndAwaitOpAsync(userOpName, "CheckFileInProjectAllowingStaleCachedResults ", filename, action >> cancellable.Return) + let execWithReactorAsync action = reactor.EnqueueAndAwaitOpAsync(userOpName, "CheckFileInProjectAllowingStaleCachedResults ", filename, action) async { try if implicitlyStartBackgroundWork then reactor.CancelBackgroundOp() // cancel the background work, since we will start new work after we're done let! cachedResults = - execWithReactorAsync <| fun ctok -> + execWithReactorAsync <| fun ctok -> + cancellable { + let! _builderOpt,_creationErrors,decrement = getOrCreateBuilderAndKeepAlive (ctok, options, userOpName) + use _unwind = decrement + match incrementalBuildersCache.TryGetAny (ctok, options) with | Some (Some builder, creationErrors, _) -> match bc.GetCachedCheckFileResult(builder, filename, source, options) with - | Some (_, checkResults) -> Some (builder, creationErrors, Some (FSharpCheckFileAnswer.Succeeded checkResults)) - | _ -> Some (builder, creationErrors, None) - | _ -> None // the builder wasn't ready + | Some (_, checkResults) -> return Some (builder, creationErrors, Some (FSharpCheckFileAnswer.Succeeded checkResults)) + | _ -> return Some (builder, creationErrors, None) + | _ -> return None // the builder wasn't ready + } match cachedResults with | None -> return None @@ -2526,8 +2507,11 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CheckFileInProjectAllowingStaleCachedResults.CacheMiss", filename) let! tcPrior = execWithReactorAsync <| fun ctok -> + cancellable { DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename + return builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename + } + match tcPrior with | Some tcPrior -> let! checkResults = bc.CheckOneFileImpl(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) @@ -2574,7 +2558,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC use _unwind = decrement match builderOpt with | None -> - let parseResults = FSharpParseFileResults(List.toArray creationErrors, None, true, []) + let parseResults = FSharpParseFileResults(List.toArray creationErrors, None, true, [| |]) return (parseResults, FSharpCheckFileAnswer.Aborted) | Some builder -> @@ -2589,9 +2573,8 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let! tcPrior = execWithReactorAsync <| fun ctok -> builder.GetCheckResultsBeforeFileInProject (ctok, filename) // Do the parsing. - let! parseErrors, _matchPairs, inputOpt, anyErrors = - execWithReactorAsync <| fun ctok -> - Parser.ParseOneFile (ctok, source, false, true, filename, builder.SourceFiles, builder.TcConfig) |> cancellable.Return + let parsingOptions = FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList (builder.SourceFiles)) + let parseErrors, inputOpt, anyErrors = Parser.parseFile (source, filename, parsingOptions, userOpName) let parseResults = FSharpParseFileResults(parseErrors, inputOpt, anyErrors, builder.AllDependenciesDeprecated) let! checkResults = bc.CheckOneFileImpl(parseResults, source, filename, options, textSnapshotInfo, fileVersion, builder, tcPrior, creationErrors, userOpName) @@ -2608,14 +2591,15 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC use _unwind = decrement match builderOpt with | None -> - let parseResults = FSharpParseFileResults(Array.ofList creationErrors, None, true, []) + let parseResults = FSharpParseFileResults(Array.ofList creationErrors, None, true, [| |]) let typedResults = MakeCheckFileResultsEmpty(filename, creationErrors) return (parseResults, typedResults) | Some builder -> let! (inputOpt, _, _, untypedErrors) = builder.GetParseResultsForFile (ctok, filename) let! tcProj = builder.GetCheckResultsAfterFileInProject (ctok, filename) - let untypedErrors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (builder.TcConfig, false, filename, untypedErrors) |] - let tcErrors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (builder.TcConfig, false, filename, tcProj.Errors) |] + let errorOptions = builder.TcConfig.errorSeverityOptions + let untypedErrors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (errorOptions, false, filename, untypedErrors) |] + let tcErrors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (errorOptions, false, filename, tcProj.Errors) |] let parseResults = FSharpParseFileResults(errors = untypedErrors, input = inputOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.TryGet (ltok, options) ) let scope = @@ -2624,8 +2608,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC List.last tcProj.TcResolutions, List.last tcProj.TcSymbolUses, tcProj.TcEnvAtEnd.NameEnv, - loadClosure, reactorOps, (fun () -> builder.IsAlive), None) - let typedResults = MakeCheckFileResults(filename, options, builder, scope, tcProj.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) + loadClosure, reactorOps, (fun () -> builder.IsAlive), None, + tcProj.ImplementationFiles) + let typedResults = MakeCheckFileResults(filename, options, builder, scope, Array.ofList tcProj.TcDependencyFiles, creationErrors, parseResults.Errors, tcErrors) return (parseResults, typedResults) }) @@ -2635,10 +2620,10 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC match source with | Some sourceText -> parseCacheLock.AcquireLock (fun ltok -> - match parseAndCheckFileInProjectCache.TryGet(ltok,(filename,sourceText,options)) with + match checkFileInProjectCache.TryGet(ltok,(filename,sourceText,options)) with | Some (a,b,c,_) -> Some (a,b,c) | None -> None) - | None -> parseCacheLock.AcquireLock (fun ltok -> parseAndCheckFileInProjectCachePossiblyStale.TryGet(ltok,(filename,options))) + | None -> parseCacheLock.AcquireLock (fun ltok -> checkFileInProjectCachePossiblyStale.TryGet(ltok,(filename,options))) /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private bc.ParseAndCheckProjectImpl(options, ctok, userOpName) : Cancellable = @@ -2650,8 +2635,10 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC return FSharpCheckProjectResults (options.ProjectFileName, keepAssemblyContents, Array.ofList creationErrors, None, reactorOps) | Some builder -> let! (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject(ctok) - let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (tcProj.TcConfig, true, Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation, tcProj.Errors) |] - return FSharpCheckProjectResults (options.ProjectFileName, keepAssemblyContents, errors, Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.PartialAssemblySignature, tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt, tcProj.TcDependencyFiles), reactorOps) + let errorOptions = tcProj.TcConfig.errorSeverityOptions + let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation + let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (errorOptions, true, fileName, tcProj.Errors) |] + return FSharpCheckProjectResults (options.ProjectFileName, 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) } /// Get the timestamp that would be on the output if fully built immediately @@ -2787,9 +2774,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member bc.ClearCachesAsync (userOpName) = reactor.EnqueueAndAwaitOpAsync (userOpName, "ClearCachesAsync", "", fun ctok -> parseCacheLock.AcquireLock (fun ltok -> - parseAndCheckFileInProjectCachePossiblyStale.Clear ltok - parseAndCheckFileInProjectCache.Clear ltok - parseFileInProjectCache.Clear ltok) + checkFileInProjectCachePossiblyStale.Clear ltok + checkFileInProjectCache.Clear ltok + parseFileCache.Clear(ltok)) incrementalBuildersCache.Clear ctok frameworkTcImportsCache.Clear ctok scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.Clear ltok) @@ -2798,9 +2785,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC member bc.DownsizeCaches(userOpName) = reactor.EnqueueAndAwaitOpAsync (userOpName, "DownsizeCaches", "", fun ctok -> parseCacheLock.AcquireLock (fun ltok -> - parseAndCheckFileInProjectCachePossiblyStale.Resize(ltok, keepStrongly=1) - parseAndCheckFileInProjectCache.Resize(ltok, keepStrongly=1) - parseFileInProjectCache.Resize(ltok, keepStrongly=1)) + checkFileInProjectCachePossiblyStale.Resize(ltok, keepStrongly=1) + checkFileInProjectCache.Resize(ltok, keepStrongly=1) + parseFileCache.Resize(ltok, keepStrongly=1)) incrementalBuildersCache.Resize(ctok, keepStrongly=1, keepMax=1) frameworkTcImportsCache.Downsize(ctok) scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.Resize(ltok,keepStrongly=1, keepMax=1)) @@ -2830,10 +2817,7 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten // background UI thread, not on the compiler thread. // // This cache is safe for concurrent access because there is no onDiscard action for the items in the cache. - let braceMatchCache = - MruCache(braceMatchCacheSize, - areSame=AreSameForParsing3, - areSimilar=AreSubsumable3) + let braceMatchCache = MruCache(braceMatchCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) let mutable maxMemoryReached = false let mutable maxMB = maxMBDefault @@ -2854,22 +2838,38 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten member ic.ReferenceResolver = legacyReferenceResolver - member ic.MatchBraces(filename, source, options, ?userOpName: string) = + member ic.MatchBraces(filename, source, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - async { - match braceMatchCache.TryGet (AssumeAnyCallerThreadWithoutEvidence(), (filename, source, options)) with + async { + match braceMatchCache.TryGet(AssumeAnyCallerThreadWithoutEvidence(), (filename, source, options)) with | Some res -> return res - | None -> - let! res = backgroundCompiler.MatchBraces(filename, source, options, userOpName) - braceMatchCache.Set (AssumeAnyCallerThreadWithoutEvidence(), (filename, source, options), res) - return res - } + | None -> + let res = Parser.matchBraces(source, filename, options, userOpName) + braceMatchCache.Set(AssumeAnyCallerThreadWithoutEvidence(), (filename, source, options), res) + return res + } - member ic.ParseFileInProject(filename, source, options, ?userOpName: string) = + member ic.GetParsingOptionsFromProjectOptions(options): FSharpParsingOptions * _ = + let sourceFiles = List.ofArray options.SourceFiles + let argv = List.ofArray options.OtherOptions + ic.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv) + + member ic.MatchBraces(filename, source, options: FSharpProjectOptions, ?userOpName: string) = + let userOpName = defaultArg userOpName "Unknown" + let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) + ic.MatchBraces(filename, source, parsingOptions, userOpName) + + member ic.ParseFile(filename, source, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" ic.CheckMaxMemoryReached() - backgroundCompiler.ParseFileInProject(filename, source, options, userOpName) - + backgroundCompiler.ParseFile(filename, source, options, userOpName) + + + member ic.ParseFileInProject(filename, source, options, ?userOpName: string) = + let userOpName = defaultArg userOpName "Unknown" + let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) + ic.ParseFile(filename, source, parsingOptions, userOpName) + member ic.GetBackgroundParseResultsForFileInProject (filename,options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" backgroundCompiler.GetBackgroundParseResultsForFileInProject(filename, options, userOpName) @@ -3055,6 +3055,17 @@ type FSharpChecker(legacyReferenceResolver, projectCacheSize, keepAssemblyConten ExtraProjectInfo=extraProjectInfo Stamp = None } + member ic.GetParsingOptionsFromCommandLineArgs(initialSourceFiles, argv) = + use errorScope = new ErrorScope() + let tcConfigBuilder = TcConfigBuilder.Initial + + // Apply command-line arguments and collect more source files if they are in the arguments + let sourceFilesNew = ApplyCommandLineArgs(tcConfigBuilder, initialSourceFiles, argv) + FSharpParsingOptions.FromTcConfigBuidler(tcConfigBuilder, Array.ofList sourceFilesNew), errorScope.Diagnostics + + member ic.GetParsingOptionsFromCommandLineArgs(argv) = + ic.GetParsingOptionsFromCommandLineArgs([], argv) + /// Begin background parsing the given project. member ic.StartBackgroundCompile(options, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" @@ -3124,9 +3135,9 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio let userOpName = defaultArg userOpName "Unknown" let filename = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") // Note: projectSourceFiles is only used to compute isLastCompiland, and is ignored if Build.IsScript(mainInputFileName) is true (which it is in this case). - let projectSourceFiles = [ ] - let parseErrors, _matchPairs, inputOpt, anyErrors = Parser.ParseOneFile (ctok, source, false, true, filename, projectSourceFiles, tcConfig) - let dependencyFiles = [] // interactions have no dependencies + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| filename |]) + let parseErrors, inputOpt, anyErrors = Parser.parseFile (source, filename, parsingOptions, userOpName) + let dependencyFiles = [| |] // interactions have no dependencies let parseResults = FSharpParseFileResults(parseErrors, inputOpt, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) let backgroundDiagnostics = [] @@ -3140,11 +3151,11 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio let loadClosure = LoadClosure.ComputeClosureOfSourceText(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, CodeContext.Editing, tcConfig.useSimpleResolution, tcConfig.useFsiAuxLib, new Lexhelp.LexResourceManager(), applyCompilerOptions, assumeDotNetFramework) let! tcErrors, tcFileResult = Parser.CheckOneFile(parseResults, source, filename, "project", tcConfig, tcGlobals, tcImports, tcState, Some loadClosure, backgroundDiagnostics, reactorOps, (fun () -> true), None, userOpName) - return + return match tcFileResult with | Parser.TypeCheckAborted.No scope -> let errors = [| yield! parseErrors; yield! tcErrors |] - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps) + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps, false) let projectResults = FSharpCheckProjectResults (filename, keepAssemblyContents, errors, Some(tcGlobals, tcImports, scope.ThisCcu, scope.CcuSig, [scope.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles), reactorOps) parseResults, typeCheckResults, projectResults | _ -> @@ -3167,21 +3178,9 @@ module CompilerEnvironment = let DefaultReferencesForOrphanSources(assumeDotNetFramework) = DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) /// Publish compiler-flags parsing logic. Must be fast because its used by the colorizer. - let GetCompilationDefinesForEditing(filename:string, compilerFlags : string list) = - let defines = ref(SourceFileImpl.AdditionalDefinesForUseInEditor(filename)) - let MatchAndExtract(flag:string,prefix:string) = - if flag.StartsWith(prefix) then - let sub = flag.Substring(prefix.Length) - let trimmed = sub.Trim() - defines := trimmed :: !defines - let rec QuickParseDefines = function - | hd :: tail -> - MatchAndExtract(hd,"-d:") - MatchAndExtract(hd,"--define:") - QuickParseDefines tail - | _ -> () - QuickParseDefines compilerFlags - !defines + let GetCompilationDefinesForEditing(filename:string, parsingOptions: FSharpParsingOptions) = + SourceFileImpl.AdditionalDefinesForUseInEditor(filename) @ + parsingOptions.ConditionalCompilationDefines /// Return true if this is a subcategory of error or warning message that the language service can emit let IsCheckerSupportedSubcategory(subcategory:string) = diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 2d55ebd91f..986b9a0e4c 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -122,7 +122,7 @@ type internal FSharpCheckFileResults = /// Indicates the set of files which must be watched to accurately track changes that affect these results, /// Clients interested in reacting to updates to these files should watch these files and take actions as described /// in the documentation for compiler service. - member DependencyFiles : string list + member DependencyFiles : string[] /// Get the items for a declaration list /// @@ -262,6 +262,9 @@ type internal FSharpCheckFileResults = /// An optional string used for tracing compiler operations associated with this request. member internal IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ?userOpName: string -> Async + /// Represents complete typechecked implementation files, including thier typechecked signatures if any. + member ImplementationFiles: FSharpImplementationFileContents list option + /// A handle to the results of CheckFileInProject. [] #if COMPILER_PUBLIC_API @@ -294,7 +297,7 @@ type internal FSharpCheckProjectResults = /// Indicates the set of files which must be watched to accurately track changes that affect these results, /// Clients interested in reacting to updates to these files should watch these files and take actions as described /// in the documentation for compiler service. - member DependencyFiles: string list + member DependencyFiles: string[] /// Unused in this API #if COMPILER_PUBLIC_API @@ -303,6 +306,22 @@ type UnresolvedReferencesSet type internal UnresolvedReferencesSet #endif +/// Options used to determine active --define conditionals and other options relevant to parsing files in a project +#if COMPILER_PUBLIC_API +type FSharpParsingOptions = +#else +type internal FSharpParsingOptions = +#endif + { + SourceFiles: string[] + ConditionalCompilationDefines: string list + ErrorSeverityOptions: FSharpErrorSeverityOptions + LightSyntax: bool option + CompilingFsLib: bool + IsExe: bool + } + static member Default: FSharpParsingOptions + /// A set of information describing a project or script build configuration. #if COMPILER_PUBLIC_API type FSharpProjectOptions = @@ -385,9 +404,32 @@ type internal FSharpChecker = /// /// The filename for the file, used to help caching of results. /// The full source for the file. - /// The options for the project or script, used to determine active --define conditionals and other options relevant to parsing. + /// Parsing options for the project or script. + /// An optional string used for tracing compiler operations associated with this request. + member MatchBraces: filename: string * source: string * options: FSharpParsingOptions * ?userOpName: string -> Async<(range * range)[]> + + /// + /// Parse a source code file, returning information about brace matching in the file. + /// Return an enumeration of the matching parenthetical tokens in the file. + /// + /// + /// The filename for the file, used to help caching of results. + /// The full source for the file. + /// Parsing options for the project or script. /// An optional string used for tracing compiler operations associated with this request. - member MatchBraces : filename : string * source: string * options: FSharpProjectOptions * ?userOpName: string -> Async<(range * range)[]> + [] + member MatchBraces: filename: string * source: string * options: FSharpProjectOptions * ?userOpName: string -> Async<(range * range)[]> + + /// + /// Parse a source code file, returning a handle that can be used for obtaining navigation bar information + /// To get the full information, call 'CheckFileInProject' method on the result + /// + /// + /// The filename for the file. + /// The full source for the file. + /// Parsing options for the project or script. + /// An optional string used for tracing compiler operations associated with this request. + member ParseFile: filename: string * source: string * options: FSharpParsingOptions * ?userOpName: string -> Async /// /// Parse a source code file, returning a handle that can be used for obtaining navigation bar information @@ -399,7 +441,8 @@ type internal FSharpChecker = /// The full source for the file. /// The options for the project or script, used to determine active --define conditionals and other options relevant to parsing. /// An optional string used for tracing compiler operations associated with this request. - member ParseFileInProject : filename: string * source: string * options: FSharpProjectOptions * ?userOpName: string -> Async + [] + member ParseFileInProject: filename: string * source: string * options: FSharpProjectOptions * ?userOpName: string -> Async /// /// Check a source code file, returning a handle to the results of the parse including @@ -412,7 +455,7 @@ type internal FSharpChecker = /// /// /// - /// The results of ParseFileInProject for this file. + /// The results of ParseFile for this file. /// The name of the file in the project whose source is being checked. /// An integer that can be used to indicate the version of the file. This will be returned by TryGetRecentCheckResultsForFile when looking up the file. /// The full source for the file. @@ -423,6 +466,7 @@ type internal FSharpChecker = /// can be used to marginally increase accuracy of intellisense results in some situations. /// /// An optional string used for tracing compiler operations associated with this request. + [] member CheckFileInProjectAllowingStaleCachedResults : parsed: FSharpParseFileResults * filename: string * fileversion: int * source: string * options: FSharpProjectOptions * ?textSnapshotInfo: obj * ?userOpName: string -> Async /// @@ -437,7 +481,7 @@ type internal FSharpChecker = /// /// /// - /// The results of ParseFileInProject for this file. + /// The results of ParseFile for this file. /// The name of the file in the project whose source is being checked. /// An integer that can be used to indicate the version of the file. This will be returned by TryGetRecentCheckResultsForFile when looking up the file. /// The full source for the file. @@ -515,9 +559,31 @@ type internal FSharpChecker = /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project, /// so that references are re-resolved. member GetProjectOptionsFromCommandLineArgs : projectFileName: string * argv: string[] * ?loadedTimeStamp: DateTime * ?extraProjectInfo: obj -> FSharpProjectOptions - + + /// + /// Get the FSharpParsingOptions implied by a set of command line arguments and list of source files. + /// + /// + /// Initial source files list. Additional files may be added during argv evaluation. + /// The command line arguments for the project build. + member GetParsingOptionsFromCommandLineArgs: sourceFiles: string list * argv: string list -> FSharpParsingOptions * FSharpErrorInfo list + + /// + /// Get the FSharpParsingOptions implied by a set of command line arguments. + /// + /// + /// The command line arguments for the project build. + member GetParsingOptionsFromCommandLineArgs: argv: string list -> FSharpParsingOptions * FSharpErrorInfo list + + /// + /// Get the FSharpParsingOptions implied by a FSharpProjectOptions. + /// + /// + /// The command line arguments for the project build. + member GetParsingOptionsFromProjectOptions: FSharpProjectOptions -> FSharpParsingOptions * FSharpErrorInfo list + /// - /// Like ParseFileInProject, but uses results from the background builder. + /// Like ParseFile, but uses results from the background builder. /// All files are read from the FileSystem API, including the file being checked. /// /// @@ -527,7 +593,7 @@ type internal FSharpChecker = member GetBackgroundParseResultsForFileInProject : filename : string * options : FSharpProjectOptions * ?userOpName: string -> Async /// - /// Like ParseFileInProject, but uses the existing results from the background builder. + /// Like CheckFileInProject, but uses the existing results from the background builder. /// All files are read from the FileSystem API, including the file being checked. /// /// @@ -703,7 +769,7 @@ module internal CompilerEnvironment = /// are not associated with a project. val DefaultReferencesForOrphanSources : assumeDotNetFramework: bool -> string list /// Return the compilation defines that should be used when editing the given file. - val GetCompilationDefinesForEditing : filename : string * compilerFlags : string list -> string list + val GetCompilationDefinesForEditing : filename : string * parsingOptions : FSharpParsingOptions -> string list /// Return true if this is a subcategory of error or warning message that the language service can emit val IsCheckerSupportedSubcategory : string -> bool diff --git a/src/ilx/EraseClosures.fs b/src/ilx/EraseClosures.fs index 43aeb42147..80329249c3 100644 --- a/src/ilx/EraseClosures.fs +++ b/src/ilx/EraseClosures.fs @@ -11,7 +11,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.IlxSettings open Microsoft.FSharp.Compiler.AbstractIL.Morphs -open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.PrettyNaming @@ -21,16 +20,14 @@ open Microsoft.FSharp.Compiler.PrettyNaming // -------------------------------------------------------------------- let notlazy v = Lazy.CreateFromValue v -let logging = false -let _ = if logging then dprintn "*** warning: Clo2_erase.logging is on" let rec stripUpTo n test dest x = - if n = 0 then ([],x) else + if n = 0 then ([], x) else if test x then - let l,r = dest x - let ls,res = stripUpTo (n-1) test dest r - (l::ls),res - else ([],x) + let l, r = dest x + let ls, res = stripUpTo (n-1) test dest r + (l::ls), res + else ([], x) // -------------------------------------------------------------------- // Flags. These need to match the various classes etc. in the @@ -42,9 +39,9 @@ let rec stripUpTo n test dest x = // the closure environment. // -------------------------------------------------------------------- -let destTyLambda = function Lambdas_forall(l,r) -> (l,r) | _ -> failwith "no" -let isTyLambda = function Lambdas_forall(_l,_r) -> true | _ -> false -let isTyApp = function Apps_tyapp (_b,_c) ->true | _ -> false +let destTyLambda = function Lambdas_forall(l, r) -> (l, r) | _ -> failwith "no" +let isTyLambda = function Lambdas_forall _ -> true | _ -> false +let isTyApp = function Apps_tyapp _ -> true | _ -> false let stripTyLambdasUpTo n lambdas = stripUpTo n isTyLambda destTyLambda lambdas @@ -63,16 +60,16 @@ let stripTyLambdasUpTo n lambdas = stripUpTo n isTyLambda destTyLambda lambdas // and type applications are never mixed in a single step. let stripSupportedIndirectCall apps = match apps with - | Apps_app(x,Apps_app(y,Apps_app(z,Apps_app(w,Apps_app(v,rest))))) -> [],[x;y;z;w;v],rest - | Apps_app(x,Apps_app(y,Apps_app(z,Apps_app(w,rest)))) -> [],[x;y;z;w],rest - | Apps_app(x,Apps_app(y,Apps_app(z,rest))) -> [],[x;y;z],rest - | Apps_app(x,Apps_app(y,rest)) -> [],[x;y],rest - | Apps_app(x,rest) -> [],[x],rest + | Apps_app(x, Apps_app(y, Apps_app(z, Apps_app(w, Apps_app(v, rest))))) -> [], [x;y;z;w;v], rest + | Apps_app(x, Apps_app(y, Apps_app(z, Apps_app(w, rest)))) -> [], [x;y;z;w], rest + | Apps_app(x, Apps_app(y, Apps_app(z, rest))) -> [], [x;y;z], rest + | Apps_app(x, Apps_app(y, rest)) -> [], [x;y], rest + | Apps_app(x, rest) -> [], [x], rest | Apps_tyapp _ -> let maxTyApps = 1 - let tys,rest = stripUpTo maxTyApps isTyApp destTyFuncApp apps - tys,[],rest - | rest -> [],[],rest + let tys, rest = stripUpTo maxTyApps isTyApp destTyFuncApp apps + tys, [], rest + | rest -> [], [], rest // Supported conventions for baking closures: // 0 @@ -86,24 +83,24 @@ let stripSupportedIndirectCall apps = // and type applications are never mixed in a single step. let stripSupportedAbstraction lambdas = match lambdas with - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,Lambdas_lambda(w,Lambdas_lambda(v,rest))))) -> [],[ x;y;z;w;v ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,Lambdas_lambda(w,rest)))) -> [],[ x;y;z;w ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,Lambdas_lambda(z,rest))) -> [],[ x;y;z ],rest - | Lambdas_lambda(x,Lambdas_lambda(y,rest)) -> [],[ x;y ],rest - | Lambdas_lambda(x,rest) -> [],[ x ],rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, Lambdas_lambda(w, Lambdas_lambda(v, rest))))) -> [], [ x;y;z;w;v ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, Lambdas_lambda(w, rest)))) -> [], [ x;y;z;w ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, Lambdas_lambda(z, rest))) -> [], [ x;y;z ], rest + | Lambdas_lambda(x, Lambdas_lambda(y, rest)) -> [], [ x;y ], rest + | Lambdas_lambda(x, rest) -> [], [ x ], rest | Lambdas_forall _ -> let maxTyApps = 1 - let tys,rest = stripTyLambdasUpTo maxTyApps lambdas - tys,[ ],rest - | rest -> [],[ ],rest + let tys, rest = stripTyLambdasUpTo maxTyApps lambdas + tys, [ ], rest + | rest -> [], [ ], rest // This must correspond to stripSupportedAbstraction let isSupportedDirectCall apps = match apps with - | Apps_app (_,Apps_done _) -> true - | Apps_app (_,Apps_app (_, Apps_done _)) -> true - | Apps_app (_,Apps_app (_,Apps_app (_, Apps_done _))) -> true - | Apps_app (_,Apps_app (_,Apps_app (_, Apps_app (_, Apps_done _)))) -> true + | Apps_app (_, Apps_done _) -> true + | Apps_app (_, Apps_app (_, Apps_done _)) -> true + | Apps_app (_, Apps_app (_, Apps_app (_, Apps_done _))) -> true + | Apps_app (_, Apps_app (_, Apps_app (_, Apps_app (_, Apps_done _)))) -> true | Apps_tyapp _ -> false | _ -> false @@ -113,9 +110,9 @@ let isSupportedDirectCall apps = // -------------------------------------------------------------------- let mkFuncTypeRef n = - if n = 1 then mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (),IlxSettings.ilxNamespace () + ".FSharpFunc`2") - else mkILNestedTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), - [IlxSettings.ilxNamespace () + ".OptimizedClosures"], + if n = 1 then mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpFunc`2") + else mkILNestedTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), + [IlxSettings.ilxNamespace () + ".OptimizedClosures"], "FSharpFunc`"+ string (n + 1)) type cenv = { ilg:ILGlobals @@ -128,16 +125,15 @@ type cenv = let addMethodGeneratedAttrsToTypeDef cenv tdef = { tdef with Methods = tdef.Methods.AsList |> List.map (fun md -> md |> cenv.addMethodGeneratedAttrs) |> mkILMethods } -let newIlxPubCloEnv(ilg,addMethodGeneratedAttrs,addFieldGeneratedAttrs,addFieldNeverAttrs) = - { ilg=ilg; - tref_Func= Array.init 10 (fun i -> mkFuncTypeRef(i+1)); - mkILTyFuncTy=ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) - addMethodGeneratedAttrs=addMethodGeneratedAttrs - addFieldGeneratedAttrs=addFieldGeneratedAttrs - addFieldNeverAttrs=addFieldNeverAttrs} +let newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) = + { ilg = ilg + tref_Func = Array.init 10 (fun i -> mkFuncTypeRef(i+1)) + mkILTyFuncTy = ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) + addMethodGeneratedAttrs = addMethodGeneratedAttrs + addFieldGeneratedAttrs = addFieldGeneratedAttrs + addFieldNeverAttrs = addFieldNeverAttrs } let mkILTyFuncTy cenv = cenv.mkILTyFuncTy - let mkILFuncTy cenv dty rty = mkILBoxedTy cenv.tref_Func.[0] [dty;rty] let mkILCurriedFuncTy cenv dtys rty = List.foldBack (mkILFuncTy cenv) dtys rty @@ -149,47 +145,47 @@ let typ_Func cenv (dtys: ILType list) rty = let rec mkTyOfApps cenv apps = match apps with | Apps_tyapp _ -> cenv.mkILTyFuncTy - | Apps_app (dty,rest) -> mkILFuncTy cenv dty (mkTyOfApps cenv rest) + | Apps_app (dty, rest) -> mkILFuncTy cenv dty (mkTyOfApps cenv rest) | Apps_done rty -> rty let rec mkTyOfLambdas cenv lam = match lam with | Lambdas_return rty -> rty - | Lambdas_lambda (d,r) -> mkILFuncTy cenv d.Type (mkTyOfLambdas cenv r) + | Lambdas_lambda (d, r) -> mkILFuncTy cenv d.Type (mkTyOfLambdas cenv r) | Lambdas_forall _ -> cenv.mkILTyFuncTy // -------------------------------------------------------------------- // Method to call for a particular multi-application // -------------------------------------------------------------------- -let mkMethSpecForMultiApp cenv (argtys': ILType list,rty) = +let mkMethSpecForMultiApp cenv (argtys': ILType list, rty) = let n = argtys'.Length let formalArgTys = List.mapi (fun i _ -> ILType.TypeVar (uint16 i)) argtys' let formalRetTy = ILType.TypeVar (uint16 n) let inst = argtys'@[rty] if n = 1 then true, - (mkILNonGenericInstanceMethSpecInTy (mkILBoxedTy cenv.tref_Func.[0] inst,"Invoke",formalArgTys, formalRetTy)) + (mkILNonGenericInstanceMethSpecInTy (mkILBoxedTy cenv.tref_Func.[0] inst, "Invoke", formalArgTys, formalRetTy)) else false, (mkILStaticMethSpecInTy - (mkILFuncTy cenv inst.[0] inst.[1], - "InvokeFast", - [mkILCurriedFuncTy cenv formalArgTys formalRetTy]@formalArgTys, - formalRetTy, + (mkILFuncTy cenv inst.[0] inst.[1], + "InvokeFast", + [mkILCurriedFuncTy cenv formalArgTys formalRetTy]@formalArgTys, + formalRetTy, inst.Tail.Tail)) -let mkCallBlockForMultiValueApp cenv doTailCall (args',rty') = - let callvirt,mr = mkMethSpecForMultiApp cenv (args',rty') - [ ( if callvirt then I_callvirt (doTailCall,mr, None) else I_call (doTailCall,mr, None) ) ] +let mkCallBlockForMultiValueApp cenv doTailCall (args', rty') = + let callvirt, mr = mkMethSpecForMultiApp cenv (args', rty') + [ ( if callvirt then I_callvirt (doTailCall, mr, None) else I_call (doTailCall, mr, None) ) ] let mkMethSpecForClosureCall cenv (clospec: IlxClosureSpec) = - let tyargsl,argtys,rstruct = stripSupportedAbstraction clospec.FormalLambdas + let tyargsl, argtys, rstruct = stripSupportedAbstraction clospec.FormalLambdas if not (isNil tyargsl) then failwith "mkMethSpecForClosureCall: internal error" let rty' = mkTyOfLambdas cenv rstruct let argtys' = typesOfILParams argtys let minst' = clospec.GenericArgs - (mkILInstanceMethSpecInTy(clospec.ILType,"Invoke",argtys',rty',minst')) + (mkILInstanceMethSpecInTy(clospec.ILType, "Invoke", argtys', rty', minst')) // -------------------------------------------------------------------- @@ -198,106 +194,106 @@ let mkMethSpecForClosureCall cenv (clospec: IlxClosureSpec) = let mkLdFreeVar (clospec: IlxClosureSpec) (fv: IlxClosureFreeVar) = - [ mkLdarg0; mkNormalLdfld (mkILFieldSpecInTy (clospec.ILType,fv.fvName,fv.fvType) ) ] + [ mkLdarg0; mkNormalLdfld (mkILFieldSpecInTy (clospec.ILType, fv.fvName, fv.fvType) ) ] let mkCallFunc cenv allocLocal numThisGenParams tl apps = - // "callfunc" and "callclo" instructions become a series of indirect - // calls or a single direct call. - let varCount = numThisGenParams - - // Unwind the stack until the arguments given in the apps have - // all been popped off. The apps given to this function is - // what remains after the first "strip" of suitable arguments for the - // first call. - // Loaders and storers are returned in groups. Storers are used to pop - // the arguments off the stack that correspond to all the arguments in - // the apps, and the loaders are used to load them back on. - let rec unwind apps = - match apps with - | Apps_tyapp (actual,rest) -> - let rest = instAppsAux varCount [ actual ] rest - let storers,loaders = unwind rest - [] :: storers, [] :: loaders - | Apps_app (arg,rest) -> - let storers, loaders = unwind rest - let argStorers,argLoaders = - let locn = allocLocal arg - [mkStloc locn], [mkLdloc locn] - argStorers :: storers, argLoaders :: loaders - | Apps_done _ -> - [],[] + // "callfunc" and "callclo" instructions become a series of indirect + // calls or a single direct call. + let varCount = numThisGenParams + + // Unwind the stack until the arguments given in the apps have + // all been popped off. The apps given to this function is + // what remains after the first "strip" of suitable arguments for the + // first call. + // Loaders and storers are returned in groups. Storers are used to pop + // the arguments off the stack that correspond to all the arguments in + // the apps, and the loaders are used to load them back on. + let rec unwind apps = + match apps with + | Apps_tyapp (actual, rest) -> + let rest = instAppsAux varCount [ actual ] rest + let storers, loaders = unwind rest + [] :: storers, [] :: loaders + | Apps_app (arg, rest) -> + let storers, loaders = unwind rest + let argStorers, argLoaders = + let locn = allocLocal arg + [mkStloc locn], [mkLdloc locn] + argStorers :: storers, argLoaders :: loaders + | Apps_done _ -> + [], [] - let rec computePreCall fst n rest (loaders: ILInstr list) = - if fst then - let storers,(loaders2 : ILInstr list list) = unwind rest - (List.rev (List.concat storers) : ILInstr list) , List.concat loaders2 - else - stripUpTo n (function (_x::_y) -> true | _ -> false) (function (x::y) -> (x,y) | _ -> failwith "no!") loaders + let rec computePreCall fst n rest (loaders: ILInstr list) = + if fst then + let storers, (loaders2 : ILInstr list list) = unwind rest + (List.rev (List.concat storers) : ILInstr list) , List.concat loaders2 + else + stripUpTo n (function (_x::_y) -> true | _ -> false) (function (x::y) -> (x, y) | _ -> failwith "no!") loaders - let rec buildApp fst loaders apps = - // Strip off one valid indirect call. [fst] indicates if this is the - // first indirect call we're making. The code below makes use of the - // fact that term and type applications are never currently mixed for - // direct calls. - match stripSupportedIndirectCall apps with - // Type applications: REVIEW: get rid of curried tyapps - just tuple them - | tyargs,[],_ when not (isNil tyargs) -> - // strip again, instantiating as we go. we could do this while we count. - let (revInstTyArgs, rest') = - (([],apps), tyargs) ||> List.fold (fun (revArgsSoFar,cs) _ -> - let actual,rest' = destTyFuncApp cs - let rest'' = instAppsAux varCount [ actual ] rest' - ((actual :: revArgsSoFar),rest'')) - let instTyargs = List.rev revInstTyArgs - let precall,loaders' = computePreCall fst 0 rest' loaders - let doTailCall = andTailness tl false - let instrs1 = - precall @ - [ I_callvirt (doTailCall, (mkILInstanceMethSpecInTy (cenv.mkILTyFuncTy,"Specialize",[],cenv.ilg.typ_Object, instTyargs)), None) ] - let instrs1 = - // TyFunc are represented as Specialize<_> methods returning an object. - // For value types, recover result via unbox and load. - // For reference types, recover via cast. - let rtnTy = mkTyOfApps cenv rest' - instrs1 @ [ I_unbox_any rtnTy] - if doTailCall = Tailcall then instrs1 - else instrs1 @ buildApp false loaders' rest' - - // Term applications - | [],args,rest when not (isNil args) -> - let precall,loaders' = computePreCall fst args.Length rest loaders - let isLast = (match rest with Apps_done _ -> true | _ -> false) - let rty = mkTyOfApps cenv rest - let doTailCall = andTailness tl isLast - - let preCallBlock = precall - - if doTailCall = Tailcall then - let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args,rty) - preCallBlock @ callBlock - else - let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args,rty) - let restBlock = buildApp false loaders' rest - preCallBlock @ callBlock @ restBlock - - | [],[],Apps_done _rty -> [ ] - | _ -> failwith "*** Error: internal error: unknown indirect calling convention returned by stripSupportedIndirectCall" + let rec buildApp fst loaders apps = + // Strip off one valid indirect call. [fst] indicates if this is the + // first indirect call we're making. The code below makes use of the + // fact that term and type applications are never currently mixed for + // direct calls. + match stripSupportedIndirectCall apps with + // Type applications: REVIEW: get rid of curried tyapps - just tuple them + | tyargs, [], _ when not (isNil tyargs) -> + // strip again, instantiating as we go. we could do this while we count. + let (revInstTyArgs, rest') = + (([], apps), tyargs) ||> List.fold (fun (revArgsSoFar, cs) _ -> + let actual, rest' = destTyFuncApp cs + let rest'' = instAppsAux varCount [ actual ] rest' + ((actual :: revArgsSoFar), rest'')) + let instTyargs = List.rev revInstTyArgs + let precall, loaders' = computePreCall fst 0 rest' loaders + let doTailCall = andTailness tl false + let instrs1 = + precall @ + [ I_callvirt (doTailCall, (mkILInstanceMethSpecInTy (cenv.mkILTyFuncTy, "Specialize", [], cenv.ilg.typ_Object, instTyargs)), None) ] + let instrs1 = + // TyFunc are represented as Specialize<_> methods returning an object. + // For value types, recover result via unbox and load. + // For reference types, recover via cast. + let rtnTy = mkTyOfApps cenv rest' + instrs1 @ [ I_unbox_any rtnTy] + if doTailCall = Tailcall then instrs1 + else instrs1 @ buildApp false loaders' rest' + + // Term applications + | [], args, rest when not (isNil args) -> + let precall, loaders' = computePreCall fst args.Length rest loaders + let isLast = (match rest with Apps_done _ -> true | _ -> false) + let rty = mkTyOfApps cenv rest + let doTailCall = andTailness tl isLast + + let preCallBlock = precall + + if doTailCall = Tailcall then + let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args, rty) + preCallBlock @ callBlock + else + let callBlock = mkCallBlockForMultiValueApp cenv doTailCall (args, rty) + let restBlock = buildApp false loaders' rest + preCallBlock @ callBlock @ restBlock + + | [], [], Apps_done _rty -> [ ] + | _ -> failwith "*** Error: internal error: unknown indirect calling convention returned by stripSupportedIndirectCall" - buildApp true [] apps + buildApp true [] apps // Fix up I_ret instruction. Generalise to selected instr. Remove tailcalls. let convReturnInstr ty instr = match instr with | I_ret -> [I_box ty;I_ret] - | I_call (_,mspec,varargs) -> [I_call (Normalcall,mspec,varargs)] - | I_callvirt (_,mspec,varargs) -> [I_callvirt (Normalcall,mspec,varargs)] - | I_callconstraint (_,ty,mspec,varargs) -> [I_callconstraint (Normalcall,ty,mspec,varargs)] - | I_calli (_,csig,varargs) -> [I_calli (Normalcall,csig,varargs)] + | I_call (_, mspec, varargs) -> [I_call (Normalcall, mspec, varargs)] + | I_callvirt (_, mspec, varargs) -> [I_callvirt (Normalcall, mspec, varargs)] + | I_callconstraint (_, ty, mspec, varargs) -> [I_callconstraint (Normalcall, ty, mspec, varargs)] + | I_calli (_, csig, varargs) -> [I_calli (Normalcall, csig, varargs)] | _ -> [instr] -let convILMethodBody (thisClo,boxReturnTy) (il: ILMethodBody) = +let convILMethodBody (thisClo, boxReturnTy) (il: ILMethodBody) = // This increase in maxstack is historical, though it's harmless let newMax = match thisClo with @@ -313,7 +309,7 @@ let convILMethodBody (thisClo,boxReturnTy) (il: ILMethodBody) = {il with MaxStack=newMax; IsZeroInit=true; Code= code } let convMethodBody thisClo = function - | MethodBody.IL il -> MethodBody.IL (convILMethodBody (thisClo,None) il) + | MethodBody.IL il -> MethodBody.IL (convILMethodBody (thisClo, None) il) | x -> x let convMethodDef thisClo (md: ILMethodDef) = @@ -327,18 +323,18 @@ let convMethodDef thisClo (md: ILMethodDef) = let mkILFreeVarForParam (p : ILParameter) = let nm = (match p.Name with Some x -> x | None -> failwith "closure parameters must be given names") - mkILFreeVar(nm, false,p.Type) + mkILFreeVar(nm, false, p.Type) let mkILLocalForFreeVar (p: IlxClosureFreeVar) = mkILLocal p.fvType None let mkILCloFldSpecs _cenv flds = - flds |> Array.map (fun fv -> (fv.fvName,fv.fvType)) |> Array.toList + flds |> Array.map (fun fv -> (fv.fvName, fv.fvType)) |> Array.toList let mkILCloFldDefs cenv flds = flds |> Array.toList |> List.map (fun fv -> - let fdef = mkILInstanceField (fv.fvName,fv.fvType,None,ILMemberAccess.Public) + let fdef = mkILInstanceField (fv.fvName, fv.fvType, None, ILMemberAccess.Public) if fv.fvCompilerGenerated then fdef |> cenv.addFieldNeverAttrs |> cenv.addFieldGeneratedAttrs @@ -346,7 +342,7 @@ let mkILCloFldDefs cenv flds = fdef) // -------------------------------------------------------------------- -// Convert a closure. Split and chop if there are too many arguments, +// Convert a closure. Split and chop if there are too many arguments, // otherwise build the appropriate kind of thing depending on whether // it's a type abstraction or a term abstraction. // -------------------------------------------------------------------- @@ -358,11 +354,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let nowFields = clo.cloFreeVars let nowTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, td.Name) let nowTy = mkILFormalBoxedTy nowTypeRef td.GenericParams - let nowCloRef = IlxClosureRef(nowTypeRef,clo.cloStructure,nowFields) + let nowCloRef = IlxClosureRef(nowTypeRef, clo.cloStructure, nowFields) let nowCloSpec = mkILFormalCloRef td.GenericParams nowCloRef let tagApp = (Lazy.force clo.cloCode).SourceMarker - let tyargsl,tmargsl,laterStruct = stripSupportedAbstraction clo.cloStructure + let tyargsl, tmargsl, laterStruct = stripSupportedAbstraction clo.cloStructure let laterAccess = td.Access // Adjust all the argument and environment accesses @@ -373,7 +369,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let fixupArg mkEnv mkArg n = let rec findMatchingArg l c = match l with - | ((m,_)::t) -> + | ((m, _)::t) -> if n = m then mkEnv c else findMatchingArg t (c+1) | [] -> mkArg (n - argToFreeVarMap.Length + 1) @@ -396,19 +392,19 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = (int n) | i -> [i] let mainCode = morphILInstrsInILCode rewriteInstrToAccessArgsFromEnv il.Code - let ldenvCode = argToFreeVarMap |> List.mapi (fun n (_,fv) -> mkLdFreeVar laterCloSpec fv @ [mkStloc (uint16 (n+numLocals)) ]) |> List.concat + let ldenvCode = argToFreeVarMap |> List.mapi (fun n (_, fv) -> mkLdFreeVar laterCloSpec fv @ [mkStloc (uint16 (n+numLocals)) ]) |> List.concat let code = prependInstrsToCode ldenvCode mainCode {il with - Code=code; + Code=code Locals= il.Locals @ (List.map (snd >> mkILLocalForFreeVar) argToFreeVarMap) - (* maxstack may increase by 1 due to environment loads *) + // maxstack may increase by 1 due to environment loads MaxStack=il.MaxStack+1 } - match tyargsl,tmargsl,laterStruct with + match tyargsl, tmargsl, laterStruct with // CASE 1 - Type abstraction - | (_ :: _), [],_ -> + | (_ :: _), [], _ -> let addedGenParams = tyargsl let nowReturnTy = (mkTyOfLambdas cenv laterStruct) @@ -420,23 +416,23 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // application. if (match laterStruct with Lambdas_return _ -> false | _ -> true) then - let nowStruct = List.foldBack (fun x y -> Lambdas_forall(x,y)) tyargsl (Lambdas_return nowReturnTy) + let nowStruct = List.foldBack (fun x y -> Lambdas_forall(x, y)) tyargsl (Lambdas_return nowReturnTy) let laterTypeName = td.Name+"T" - let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local,encl,laterTypeName) + let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, laterTypeName) let laterGenericParams = td.GenericParams @ addedGenParams - let selfFreeVar = mkILFreeVar(CompilerGeneratedName ("self"+string nowFields.Length),true,nowCloSpec.ILType) + let selfFreeVar = mkILFreeVar(CompilerGeneratedName ("self"+string nowFields.Length), true, nowCloSpec.ILType) let laterFields = Array.append nowFields [| selfFreeVar |] - let laterCloRef = IlxClosureRef(laterTypeRef,laterStruct,laterFields) + let laterCloRef = IlxClosureRef(laterTypeRef, laterStruct, laterFields) let laterCloSpec = mkILFormalCloRef laterGenericParams laterCloRef let laterCode = rewriteCodeToAccessArgsFromEnv laterCloSpec [(0, selfFreeVar)] let laterTypeDefs = convIlxClosureDef cenv encl - {td with GenericParams=laterGenericParams; - Access=laterAccess; - Name=laterTypeName} - {clo with cloStructure=laterStruct; - cloFreeVars=laterFields; + {td with GenericParams=laterGenericParams + Access=laterAccess + Name=laterTypeName} + {clo with cloStructure=laterStruct + cloFreeVars=laterFields cloCode=notlazy laterCode} // This is the code which will get called when then "now" @@ -444,7 +440,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // that it is the code for a closure... let nowCode = mkILMethodBody - (false,[],nowFields.Length + 1, + (false, [], nowFields.Length + 1, nonBranchingInstrsToCode begin // Load up the environment, including self... @@ -453,11 +449,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = // Make the instance of the delegated closure && return it. // This passes the method type params. as class type params. [ I_newobj (laterCloSpec.Constructor, None) ] - end, + end, tagApp) let nowTypeDefs = - convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct; + convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct cloCode=notlazy nowCode} let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv) @@ -468,93 +464,93 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let boxReturnTy = Some nowReturnTy (* box prior to all I_ret *) let nowApplyMethDef = mkILGenericVirtualMethod - ("Specialize", - ILMemberAccess.Public, + ("Specialize", + ILMemberAccess.Public, addedGenParams, (* method is generic over added ILGenericParameterDefs *) - [], - mkILReturn(cenv.ilg.typ_Object), - MethodBody.IL (convILMethodBody (Some nowCloSpec,boxReturnTy) (Lazy.force clo.cloCode))) + [], + mkILReturn(cenv.ilg.typ_Object), + MethodBody.IL (convILMethodBody (Some nowCloSpec, boxReturnTy) (Lazy.force clo.cloCode))) let ctorMethodDef = mkILStorageCtor - (None, - [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ], - nowTy, - mkILCloFldSpecs cenv nowFields, + (None, + [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ], + nowTy, + mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) |> cenv.addMethodGeneratedAttrs let cloTypeDef = - { Name = td.Name; - GenericParams= td.GenericParams; - Access=td.Access; - Implements = List.empty; - IsAbstract = false; - NestedTypes = emptyILTypeDefs; - IsSealed = true; - IsSerializable=td.IsSerializable; - IsComInterop=false; - IsSpecialName=false; - Layout=ILTypeDefLayout.Auto; - Encoding=ILDefaultPInvokeEncoding.Ansi; - InitSemantics=ILTypeInit.BeforeField; - Extends= Some cenv.mkILTyFuncTy; - Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]); - Fields= mkILFields (mkILCloFldDefs cenv nowFields); - CustomAttrs=emptyILCustomAttrs; - MethodImpls=emptyILMethodImpls; - Properties=emptyILProperties; - Events=emptyILEvents; - HasSecurity=false; - SecurityDecls=emptyILSecurityDecls; - tdKind = ILTypeDefKind.Class;} + { Name = td.Name + GenericParams= td.GenericParams + Access=td.Access + Implements = List.empty + IsAbstract = false + NestedTypes = emptyILTypeDefs + IsSealed = true + IsSerializable=td.IsSerializable + IsComInterop=false + IsSpecialName=false + Layout=ILTypeDefLayout.Auto + Encoding=ILDefaultPInvokeEncoding.Ansi + InitSemantics=ILTypeInit.BeforeField + Extends= Some cenv.mkILTyFuncTy + Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]) + Fields= mkILFields (mkILCloFldDefs cenv nowFields) + CustomAttrs=emptyILCustomAttrs + MethodImpls=emptyILMethodImpls + Properties=emptyILProperties + Events=emptyILEvents + HasSecurity=false + SecurityDecls=emptyILSecurityDecls + tdKind = ILTypeDefKind.Class} [ cloTypeDef] // CASE 2 - Term Application - | [], (_ :: _ as nowParams),_ -> + | [], (_ :: _ as nowParams), _ -> let nowReturnTy = mkTyOfLambdas cenv laterStruct // CASE 2a - Too Many Term Arguments or Remaining Type arguments - Split the Closure Class in Two if (match laterStruct with Lambdas_return _ -> false | _ -> true) then - let nowStruct = List.foldBack (fun l r -> Lambdas_lambda(l,r)) nowParams (Lambdas_return nowReturnTy) + let nowStruct = List.foldBack (fun l r -> Lambdas_lambda(l, r)) nowParams (Lambdas_return nowReturnTy) let laterTypeName = td.Name+"D" - let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local,encl,laterTypeName) + let laterTypeRef = mkILNestedTyRef (ILScopeRef.Local, encl, laterTypeName) let laterGenericParams = td.GenericParams // Number each argument left-to-right, adding one to account for the "this" pointer - let selfFreeVar = mkILFreeVar(CompilerGeneratedName "self",true,nowCloSpec.ILType) + let selfFreeVar = mkILFreeVar(CompilerGeneratedName "self", true, nowCloSpec.ILType) let argToFreeVarMap = (0, selfFreeVar) :: (nowParams |> List.mapi (fun i p -> i+1, mkILFreeVarForParam p)) let laterFreeVars = argToFreeVarMap |> List.map snd |> List.toArray let laterFields = Array.append nowFields laterFreeVars - let laterCloRef = IlxClosureRef(laterTypeRef,laterStruct,laterFields) + let laterCloRef = IlxClosureRef(laterTypeRef, laterStruct, laterFields) let laterCloSpec = mkILFormalCloRef laterGenericParams laterCloRef // This is the code which will first get called. let nowCode = mkILMethodBody - (false,[],argToFreeVarMap.Length + nowFields.Length, + (false, [], argToFreeVarMap.Length + nowFields.Length, nonBranchingInstrsToCode begin // Load up the environment (nowFields |> Array.toList |> List.collect (mkLdFreeVar nowCloSpec)) @ // Load up all the arguments (including self), which become free variables in the delegated closure - (argToFreeVarMap |> List.map (fun (n,_) -> mkLdarg (uint16 n))) @ + (argToFreeVarMap |> List.map (fun (n, _) -> mkLdarg (uint16 n))) @ // Make the instance of the delegated closure && return it. [ I_newobj (laterCloSpec.Constructor, None) ] - end, + end, tagApp) let nowTypeDefs = - convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct; + convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct cloCode=notlazy nowCode} let laterCode = rewriteCodeToAccessArgsFromEnv laterCloSpec argToFreeVarMap let laterTypeDefs = convIlxClosureDef cenv encl - {td with GenericParams=laterGenericParams; - Access=laterAccess; + {td with GenericParams=laterGenericParams + Access=laterAccess Name=laterTypeName} - {clo with cloStructure=laterStruct; - cloFreeVars=laterFields; + {clo with cloStructure=laterStruct + cloFreeVars=laterFields cloCode=notlazy laterCode} // add 'compiler generated' to all the methods in the 'now' classes @@ -571,84 +567,84 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let cloTypeDef = let nowApplyMethDef = mkILNonGenericVirtualMethod - ("Invoke",ILMemberAccess.Public, + ("Invoke", ILMemberAccess.Public, nowParams, - mkILReturn nowReturnTy, - MethodBody.IL (convILMethodBody (Some nowCloSpec,None) (Lazy.force clo.cloCode))) + mkILReturn nowReturnTy, + MethodBody.IL (convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode))) let ctorMethodDef = mkILStorageCtor - (None, - [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass,[])) ], - nowTy, - mkILCloFldSpecs cenv nowFields, + (None, + [ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass, [])) ], + nowTy, + mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) |> cenv.addMethodGeneratedAttrs - { Name = td.Name; - GenericParams= td.GenericParams; - Access = td.Access; + { Name = td.Name + GenericParams= td.GenericParams + Access = td.Access Implements = [] - IsAbstract = false; - IsSealed = true; - IsSerializable=td.IsSerializable; - IsComInterop=false; - IsSpecialName=false; - Layout=ILTypeDefLayout.Auto; - Encoding=ILDefaultPInvokeEncoding.Ansi; - InitSemantics=ILTypeInit.BeforeField; - NestedTypes = emptyILTypeDefs; - Extends= Some nowEnvParentClass; - Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]); - Fields= mkILFields (mkILCloFldDefs cenv nowFields); - CustomAttrs=emptyILCustomAttrs; - MethodImpls=emptyILMethodImpls; - Properties=emptyILProperties; - Events=emptyILEvents; - HasSecurity=false; - SecurityDecls=emptyILSecurityDecls; - tdKind = ILTypeDefKind.Class; } + IsAbstract = false + IsSealed = true + IsSerializable=td.IsSerializable + IsComInterop=false + IsSpecialName=false + Layout=ILTypeDefLayout.Auto + Encoding=ILDefaultPInvokeEncoding.Ansi + InitSemantics=ILTypeInit.BeforeField + NestedTypes = emptyILTypeDefs + Extends= Some nowEnvParentClass + Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]) + Fields= mkILFields (mkILCloFldDefs cenv nowFields) + CustomAttrs=emptyILCustomAttrs + MethodImpls=emptyILMethodImpls + Properties=emptyILProperties + Events=emptyILEvents + HasSecurity=false + SecurityDecls=emptyILSecurityDecls + tdKind = ILTypeDefKind.Class } [cloTypeDef] - | [],[],Lambdas_return _ -> + | [], [], Lambdas_return _ -> // No code is being declared: just bake a (mutable) environment let cloCode' = match td.Extends with | None -> (mkILNonGenericEmptyCtor None cenv.ilg.typ_Object).MethodBody - | Some _ -> convILMethodBody (Some nowCloSpec,None) (Lazy.force clo.cloCode) + | Some _ -> convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode) let ctorMethodDef = let flds = (mkILCloFldSpecs cenv nowFields) - mkILCtor(ILMemberAccess.Public, - List.map mkILParamNamed flds, + mkILCtor(ILMemberAccess.Public, + List.map mkILParamNamed flds, mkMethodBody - (cloCode'.IsZeroInit, - cloCode'.Locals, - cloCode'.MaxStack, + (cloCode'.IsZeroInit, + cloCode'.Locals, + cloCode'.MaxStack, prependInstrsToCode - (List.concat (List.mapi (fun n (nm,ty) -> - [ mkLdarg0; - mkLdarg (uint16 (n+1)); - mkNormalStfld (mkILFieldSpecInTy (nowTy,nm,ty)); + (List.concat (List.mapi (fun n (nm, ty) -> + [ mkLdarg0 + mkLdarg (uint16 (n+1)) + mkNormalStfld (mkILFieldSpecInTy (nowTy, nm, ty)) ]) flds)) - cloCode'.Code, + cloCode'.Code, None)) let cloTypeDef = { td with - Implements= td.Implements; - Extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x)); - Name = td.Name; - GenericParams= td.GenericParams; - Methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList); - Fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList); - tdKind = ILTypeDefKind.Class; } + Implements= td.Implements + Extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x)) + Name = td.Name + GenericParams= td.GenericParams + Methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList) + Fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList) + tdKind = ILTypeDefKind.Class } [cloTypeDef] - | a,b,_ -> + | a, b, _ -> failwith ("Unexpected unsupported abstraction sequence, #tyabs = "+string a.Length + ", #tmabs = "+string b.Length) newTypeDefs diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index 07fb17b033..c75ab90f05 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -8,14 +8,12 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseUnions open System.Collections.Generic -open Internal.Utilities + open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types -open Microsoft.FSharp.Compiler.AbstractIL.Morphs [] @@ -584,7 +582,7 @@ let emitDataSwitch ilg (cg: ICodeGen<'Mark>) (avoidHelpers, cuspec, cases) = | [] -> cg.EmitInstrs [ AI_pop ] | _ -> // Use a dictionary to avoid quadratic lookup in case list - let dict = System.Collections.Generic.Dictionary() + let dict = Dictionary() for (i,case) in cases do dict.[i] <- case let failLab = cg.GenerateDelayMark () let emitCase i _ = diff --git a/src/update.cmd b/src/update.cmd index 8183310d81..89ed51b267 100644 --- a/src/update.cmd +++ b/src/update.cmd @@ -26,13 +26,14 @@ if not "%WindowsSDK_ExecutablePath_x86%" == "" goto :havesdk set REGEXE32BIT=reg.exe if not "%OSARCH%"=="x86" set REGEXE32BIT=%WINDIR%\syswow64\reg.exe - FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B -if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS_x86=%%B +::See https://stackoverflow.com/a/17113667/111575 on 2^>NUL for suppressing the error "ERROR: The system was unable to find the specified registry key or value." from reg.exe, this fixes #3619 + FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B +if "%WINSDKNETFXTOOLS_x86%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS_x86=%%B set WINSDKNETFXTOOLS_x64=%WINSDKNETFXTOOLS_x86%x64\ diff --git a/src/utils/reshapedreflection.fs b/src/utils/reshapedreflection.fs index 7f0eb87c05..19be659bfd 100644 --- a/src/utils/reshapedreflection.fs +++ b/src/utils/reshapedreflection.fs @@ -327,7 +327,15 @@ module internal ReflectionAdapters = override this.Load (assemblyName:AssemblyName):Assembly = this.LoadFromAssemblyName(assemblyName) - let globalLoadContext = new CustomAssemblyResolver() + let globalLoadContext = + // This is an unfortunate temporary fix!!!! + // ======================================== + // We need to run fsi tests on a very old version of the corclr because of an unfortunate test framework + // This hack detects that, and uses the old code. + // On slightly newer code AssemblyLoadContext.Default is the way to go. + match Seq.tryHead (typeof.GetTypeInfo().Assembly.GetCustomAttributes()) with + | Some a when a.Version = "4.6.24410.01" -> new CustomAssemblyResolver() :> AssemblyLoadContext + | _ -> AssemblyLoadContext.Default #endif type System.Reflection.Assembly with diff --git a/tests/fsharp/core/attributes/test.fsx b/tests/fsharp/core/attributes/test.fsx index 991311b972..e31a35b910 100644 --- a/tests/fsharp/core/attributes/test.fsx +++ b/tests/fsharp/core/attributes/test.fsx @@ -1333,6 +1333,7 @@ module BugWithOverloadedAttributes = [] type Bar = class end +#if !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD module Bug719b = open TestLibModule.Bug719 @@ -1340,6 +1341,7 @@ module Bug719b = type Bar = interface IFoo with member __.Test (?value:int) = value.ToString() +#endif (*------------------------------------------------------------------------- !* Test passed? diff --git a/tests/fsharp/core/printing/z.output.test.1000.stdout.bsl b/tests/fsharp/core/printing/z.output.test.1000.stdout.bsl index 882e4de4d5..1f9224b67b 100644 --- a/tests/fsharp/core/printing/z.output.test.1000.stdout.bsl +++ b/tests/fsharp/core/printing/z.output.test.1000.stdout.bsl @@ -1623,15 +1623,15 @@ val catch : f:(unit -> 'a) -> Either<'a,(string * string)> val seqFindIndexFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqFindFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqPickFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") module Regression5218 = begin val t1 : int = 1 val t2 : int * int = (1, 2) diff --git a/tests/fsharp/core/printing/z.output.test.200.stdout.bsl b/tests/fsharp/core/printing/z.output.test.200.stdout.bsl index 61a06e0b72..0877fcb800 100644 --- a/tests/fsharp/core/printing/z.output.test.200.stdout.bsl +++ b/tests/fsharp/core/printing/z.output.test.200.stdout.bsl @@ -872,15 +872,15 @@ val catch : f:(unit -> 'a) -> Either<'a,(string * string)> val seqFindIndexFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqFindFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqPickFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") module Regression5218 = begin val t1 : int = 1 val t2 : int * int = (1, 2) diff --git a/tests/fsharp/core/printing/z.output.test.default.stdout.bsl b/tests/fsharp/core/printing/z.output.test.default.stdout.bsl index 2fa1a95c0d..fab8d8dbaa 100644 --- a/tests/fsharp/core/printing/z.output.test.default.stdout.bsl +++ b/tests/fsharp/core/printing/z.output.test.default.stdout.bsl @@ -5149,15 +5149,15 @@ val catch : f:(unit -> 'a) -> Either<'a,(string * string)> val seqFindIndexFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqFindFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") val seqPickFailure : Either = That ("System.Collections.Generic.KeyNotFoundException", - "Exception of type 'System.Collections.Generic.KeyNotFoundExce"+[18 chars]) + "An index satisfying the predicate was not found in the collection.") module Regression5218 = begin val t1 : int = 1 val t2 : int * int = (1, 2) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.fs b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.fs new file mode 100644 index 0000000000..46085bc227 --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.fs @@ -0,0 +1,4 @@ +let a = 2L +let b = 20L +let c = 2147483649L +let d = 932147483649L \ No newline at end of file diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.il.bsl new file mode 100644 index 0000000000..3e6b317f3e --- /dev/null +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/Int64.il.bsl @@ -0,0 +1,134 @@ + +// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.1055.0 +// Copyright (c) Microsoft Corporation. All rights reserved. + + + +// Metadata version: v4.0.30319 +.assembly extern mscorlib +{ + .publickeytoken = (B7 7A 5C 56 19 34 E0 89 ) // .z\V.4.. + .ver 4:0:0:0 +} +.assembly extern FSharp.Core +{ + .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: + .ver 4:4:1:0 +} +.assembly Int64 +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32, + int32, + int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 ) + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.mresource public FSharpSignatureData.Int64 +{ + // Offset: 0x00000000 Length: 0x0000020D + // WARNING: managed resource file FSharpSignatureData.Int64 created +} +.mresource public FSharpOptimizationData.Int64 +{ + // Offset: 0x00000218 Length: 0x000000D4 + // WARNING: managed resource file FSharpOptimizationData.Int64 created +} +.module Int64.exe +// MVID: {59C696CC-77F4-40B2-A745-0383CC96C659} +.imagebase 0x00400000 +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 // WINDOWS_CUI +.corflags 0x00000001 // ILONLY +// Image base: 0x02640000 + + +// =============== CLASS MEMBERS DECLARATION =================== + +.class public abstract auto ansi sealed Int64 + extends [mscorlib]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .method public specialname static int64 + get_a() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 3 (0x3) + .maxstack 8 + IL_0000: ldc.i4.2 + IL_0001: conv.i8 + IL_0002: ret + } // end of method Int64::get_a + + .method public specialname static int64 + get_b() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 4 (0x4) + .maxstack 8 + IL_0000: ldc.i4.s 20 + IL_0002: conv.i8 + IL_0003: ret + } // end of method Int64::get_b + + .method public specialname static int64 + get_c() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 7 (0x7) + .maxstack 8 + IL_0000: ldc.i4 0x80000001 + IL_0005: conv.u8 + IL_0006: ret + } // end of method Int64::get_c + + .method public specialname static int64 + get_d() cil managed + { + .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [mscorlib]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + // Code size 10 (0xa) + .maxstack 8 + IL_0000: ldc.i8 0xd90851d401 + IL_0009: ret + } // end of method Int64::get_d + + .property int64 a() + { + .get int64 Int64::get_a() + } // end of property Int64::a + .property int64 b() + { + .get int64 Int64::get_b() + } // end of property Int64::b + .property int64 c() + { + .get int64 Int64::get_c() + } // end of property Int64::c + .property int64 d() + { + .get int64 Int64::get_d() + } // end of property Int64::d +} // end of class Int64 + +.class private abstract auto ansi sealed ''.$Int64 + extends [mscorlib]System.Object +{ + .method public static void main@() cil managed + { + .entrypoint + // Code size 1 (0x1) + .maxstack 8 + IL_0000: ret + } // end of method $Int64::main@ + +} // end of class ''.$Int64 + + +// ============================================================= + +// *********** DISASSEMBLY COMPLETE *********************** +// WARNING: Created Win32 resource file Int64.res diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fs b/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fs index 0adca947bc..65d7f3ba86 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fs +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fs @@ -24,7 +24,7 @@ //section='- CODE GENERATION - ' ! option=tailcalls kind=OptionSwitch //section='- CODE GENERATION - ' ! option=crossoptimize kind=OptionSwitch //section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionSwitch -//section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionIntListSwitch +//section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionStringListSwitch //section='- ERRORS AND WARNINGS - ' ! option=warn kind=OptionInt //section='- ERRORS AND WARNINGS - ' ! option=nowarn kind=OptionStringList //section='- ERRORS AND WARNINGS - ' ! option=warnon kind=OptionStringList diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fsx b/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fsx index c112b83d0d..aa84cfe70f 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fsx +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/dumpAllCommandLineOptions/dummy.fsx @@ -17,7 +17,7 @@ //section='- CODE GENERATION - ' ! option=tailcalls kind=OptionSwitch //section='- CODE GENERATION - ' ! option=crossoptimize kind=OptionSwitch //section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionSwitch -//section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionIntListSwitch +//section='- ERRORS AND WARNINGS - ' ! option=warnaserror kind=OptionStringListSwitch //section='- ERRORS AND WARNINGS - ' ! option=warn kind=OptionInt //section='- ERRORS AND WARNINGS - ' ! option=nowarn kind=OptionStringList //section='- ERRORS AND WARNINGS - ' ! option=warnon kind=OptionStringList diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/warn/env.lst b/tests/fsharpqa/Source/CompilerOptions/fsc/warn/env.lst index 38ef7217a0..7c71fc1854 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/warn/env.lst +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/warn/env.lst @@ -10,8 +10,17 @@ NoMT SOURCE=warn5_level5.fs SCFLAGS="--warn:5 --warnaserror" COMPILE_ONLY=1 # w NoMT SOURCE=warn5_level5w.fs SCFLAGS="--warn:5" COMPILE_ONLY=1 # warn5_level5w.fs SOURCE=invalid_warning_level_6.fs SCFLAGS="--warn:6" # invalid_warning_level_6.fs - SOURCE=nowarn.fs SCFLAGS="--warnaserror" # nowarn.fs + SOURCE=nowarn.fs SCFLAGS="--warnaserror" # nowarn.fs + SOURCE=warn40.fs SCFLAGS="--nowarn:40" # warn40a.fs + SOURCE=warn40.fs SCFLAGS="--nowarn:NU0000;FS40;NU0001" # warn40b.fs + SOURCE=warn40.fs SCFLAGS="--nowarn:FS0040" # warn40c.fs SOURCE=nowarn_with_warnaserror01.fs SCFLAGS="--warnaserror --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror01.fs SOURCE=nowarn_with_warnaserror02.fs SCFLAGS="--warnaserror --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror02.fs SOURCE=nowarn_with_warnaserror03.fs SCFLAGS="--warnaserror --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror03.fs + SOURCE=nowarn_with_warnaserror01.fs SCFLAGS="--warnaserror:FS0040 --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror01a.fs + SOURCE=nowarn_with_warnaserror02.fs SCFLAGS="--warnaserror:FS0040 --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror02a.fs + SOURCE=nowarn_with_warnaserror03.fs SCFLAGS="--warnaserror:FS0040 --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror03a.fs + SOURCE=nowarn_with_warnaserror01.fs SCFLAGS="--warnaserror:FS0040 --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror01b.fs + SOURCE=nowarn_with_warnaserror02.fs SCFLAGS="--warnaserror:FS0040 --warn:4" COMPILE_ONLY=1 # nowarn_with_warnaserror02b.fs + diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/warn/warn40.fs b/tests/fsharpqa/Source/CompilerOptions/fsc/warn/warn40.fs new file mode 100644 index 0000000000..c9d56fe200 --- /dev/null +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/warn/warn40.fs @@ -0,0 +1,5 @@ +// This causes a warning 40 +[] +let main argv = + let rec x = lazy(x.Value) + 0 // return an integer exit code diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/warnaserror/env.lst b/tests/fsharpqa/Source/CompilerOptions/fsc/warnaserror/env.lst index f4f1003891..fa1ebe0260 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/warnaserror/env.lst +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/warnaserror/env.lst @@ -1,3 +1,5 @@ + SOURCE=t1.fs SCFLAGS="--warnaserror+ --warnaserror-:FS25,FS26,FS988 # t1a.fs enabled, ex with all warnings, list with >1 element + SOURCE=t1.fs SCFLAGS="--warnaserror+ --warnaserror-:25,26,988 # t1.fs enabled, excl list with all warnings, list with >1 element SOURCE=t2.fs SCFLAGS="--warnaserror+ --warnaserror-:25,26 # t2.fs enabled, excl list with some warning, list with >1 element SOURCE=t3.fs SCFLAGS="--warnaserror+ --warnaserror-:25 # t3.fs enabled, excl list with one warning, list with 1 element diff --git a/tests/fsharpqa/Source/CompilerOptions/fsc/warnon/env.lst b/tests/fsharpqa/Source/CompilerOptions/fsc/warnon/env.lst index 79000e59be..b570c0a1a6 100644 --- a/tests/fsharpqa/Source/CompilerOptions/fsc/warnon/env.lst +++ b/tests/fsharpqa/Source/CompilerOptions/fsc/warnon/env.lst @@ -1,3 +1,5 @@ SOURCE=warnon01.fs SCFLAGS="--warnon:1182 --test:ErrorRanges" COMPILE_ONLY=1 # warnon01.fs SOURCE=warnon01.fsx SCFLAGS="--warnon:1182" COMPILE_ONLY=1 FSIMODE=PIPE # warnon01.fsx + SOURCE=warnon01.fs SCFLAGS="--warnon:NU0001;FS1182;NU0001 --test:ErrorRanges" COMPILE_ONLY=1 # warnon01a.fs + SOURCE=warnon01.fsx SCFLAGS="--warnon:FS1182" COMPILE_ONLY=1 FSIMODE=PIPE # warnon01a.fsx diff --git a/tests/fsharpqa/testenv/src/HostedCompilerServer/App.config b/tests/fsharpqa/testenv/src/HostedCompilerServer/App.config index f888c777ac..885af92830 100644 --- a/tests/fsharpqa/testenv/src/HostedCompilerServer/App.config +++ b/tests/fsharpqa/testenv/src/HostedCompilerServer/App.config @@ -6,5 +6,15 @@ + + + + + + + + + + \ No newline at end of file diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj index ff706fae87..7cbff76e35 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj @@ -1,73 +1,5 @@  - - - Debug - AnyCPU - 2.0 - b5b8c6fd-d77d-46e6-a9c5-5d78200668cc - Exe - Sample_VS2012_FSharp_ConsoleApp_net45 - Sample_VS2012_FSharp_ConsoleApp_net45 - v4.5 - Sample_VS2012_FSharp_ConsoleApp_net45 - 10.0.0 - False - - - True - full - False - False - bin\Debug\ - DEBUG;TRACE - 3 - AnyCPU - bin\Debug\Sample_VS2012_FSharp_ConsoleApp_net45.xml - true - - - pdbonly - True - True - bin\Release\ - TRACE - 3 - AnyCPU - bin\Release\Sample_VS2012_FSharp_ConsoleApp_net45.xml - true - False - - - - - - - - - - - - - - 11 - - - - - - - - - PreserveNewest - - Debug @@ -137,8 +69,11 @@ - + + true + + true The.Explicit.Name.Of.ResxResourceWithLogicalName @@ -150,8 +85,11 @@ - + + true + + true The.Explicit.Name.Of.ResxResourceWithLogicalNameInSubDir @@ -167,6 +105,5 @@ - \ No newline at end of file diff --git a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource_using_bootstrap/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource_using_bootstrap/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj index 447c4c5d52..fbbac89edf 100644 --- a/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource_using_bootstrap/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj +++ b/tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource_using_bootstrap/Sample_VS2012_FSharp_ConsoleApp_net45/Sample_VS2012_FSharp_ConsoleApp_net45.fsproj @@ -16,6 +16,7 @@ 4.4.0.0 $(MSBuildProjectDirectory)\..\..\..\..\packages\FSharp.Compiler.Tools\tools $(MSBuildProjectDirectory)\..\..\..\..\packages\FSharp.Compiler.Tools.4.1.5\tools + $(MSBuildProjectDirectory)\..\..\..\..\packages\FSharp.Compiler.Tools.4.1.27\tools True @@ -59,8 +60,11 @@ - + + true + + true The.Explicit.Name.Of.ResxResourceWithLogicalName @@ -72,8 +76,11 @@ - + + true + + true The.Explicit.Name.Of.ResxResourceWithLogicalNameInSubDir diff --git a/tests/service/CSharpProjectAnalysis.fs b/tests/service/CSharpProjectAnalysis.fs index 67260b6548..188d733cd1 100644 --- a/tests/service/CSharpProjectAnalysis.fs +++ b/tests/service/CSharpProjectAnalysis.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../bin/v4.5/CSharp_Analysis.dll" #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 9f5e567617..ef3049110e 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -192,8 +192,8 @@ let parseSourceCode (name: string, code: string) = let filePath = Path.Combine(location, name + ".fs") let dllPath = Path.Combine(location, name + ".dll") let args = mkProjectCommandLineArgs(dllPath, [filePath]) - let options = checker.GetProjectOptionsFromCommandLineArgs(projPath, args) - let parseResults = checker.ParseFileInProject(filePath, code, options) |> Async.RunSynchronously + let options, errors = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) + let parseResults = checker.ParseFile(filePath, code, options) |> Async.RunSynchronously parseResults.ParseTree /// Extract range info diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index bc93a3331c..8b70eeda1b 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -19,7 +19,7 @@ // Use F# Interactive. This only works for FSHarp.Compiler.Service.dll which has a public API #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 0fe1dffcf5..ed366d2d15 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../Debug/net40/bin/FSharp.Compiler.Service.ProjectCracker.dll" #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" diff --git a/tests/service/FileSystemTests.fs b/tests/service/FileSystemTests.fs index ee5f1f3603..4e92e98b70 100644 --- a/tests/service/FileSystemTests.fs +++ b/tests/service/FileSystemTests.fs @@ -1,5 +1,5 @@ #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/FscTests.fs b/tests/service/FscTests.fs index c2ba5396c2..97f1ee7592 100644 --- a/tests/service/FscTests.fs +++ b/tests/service/FscTests.fs @@ -1,6 +1,6 @@ #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/FsiTests.fs b/tests/service/FsiTests.fs index 5449d44114..bd80961002 100644 --- a/tests/service/FsiTests.fs +++ b/tests/service/FsiTests.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/InteractiveCheckerTests.fs b/tests/service/InteractiveCheckerTests.fs index e1ad86c2bf..ac17ec2e70 100644 --- a/tests/service/InteractiveCheckerTests.fs +++ b/tests/service/InteractiveCheckerTests.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/MultiProjectAnalysisTests.fs b/tests/service/MultiProjectAnalysisTests.fs index 583cf53081..b6adcce204 100644 --- a/tests/service/MultiProjectAnalysisTests.fs +++ b/tests/service/MultiProjectAnalysisTests.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" @@ -38,13 +38,24 @@ module internal Project1A = let fileSource1 = """ module Project1A +/// This is type C type C() = static member M(arg1: int, arg2: int, ?arg3 : int) = arg1 + arg2 + defaultArg arg3 4 +/// This is x1 let x1 = C.M(arg1 = 3, arg2 = 4, arg3 = 5) +/// This is x2 let x2 = C.M(arg1 = 3, arg2 = 4, ?arg3 = Some 5) +/// This is type U +type U = + + /// This is Case1 + | Case1 of int + + /// This is Case2 + | Case2 of string """ File.WriteAllText(fileName1, fileSource1) @@ -100,7 +111,8 @@ open Project1A open Project1B let p = (Project1A.x1, Project1B.b) - +let c = C() +let u = Case1 3 """ File.WriteAllText(fileName1, fileSource1) @@ -138,7 +150,7 @@ let ``Test multi project 1 basic`` () = [ for x in wholeProjectResults.AssemblySignature.Entities.[0].MembersFunctionsAndValues -> x.DisplayName ] - |> shouldEqual ["p"] + |> shouldEqual ["p"; "c"; "u"] [] let ``Test multi project 1 all symbols`` () = @@ -180,6 +192,54 @@ let ``Test multi project 1 all symbols`` () = usesOfx1FromProject1AInMultiProject1 |> shouldEqual usesOfx1FromMultiProject1InMultiProject1 +[] +let ``Test multi project 1 xmldoc`` () = + + let p1A = checker.ParseAndCheckProject(Project1A.options) |> Async.RunSynchronously + let p1B = checker.ParseAndCheckProject(Project1B.options) |> Async.RunSynchronously + let mp = checker.ParseAndCheckProject(MultiProject1.options) |> Async.RunSynchronously + + let x1FromProject1A = + [ for s in p1A.GetAllUsesOfAllSymbols() |> Async.RunSynchronously do + if s.Symbol.DisplayName = "x1" then + yield s.Symbol ] |> List.head + + let x1FromProjectMultiProject = + [ for s in mp.GetAllUsesOfAllSymbols() |> Async.RunSynchronously do + if s.Symbol.DisplayName = "x1" then + yield s.Symbol ] |> List.head + + let ctorFromProjectMultiProject = + [ for s in mp.GetAllUsesOfAllSymbols() |> Async.RunSynchronously do + if s.Symbol.DisplayName = "C" then + yield s.Symbol ] |> List.head + + let case1FromProjectMultiProject = + [ for s in mp.GetAllUsesOfAllSymbols() |> Async.RunSynchronously do + if s.Symbol.DisplayName = "Case1" then + yield s.Symbol ] |> List.head + + + match x1FromProject1A with + | :? FSharpMemberOrFunctionOrValue as v -> v.XmlDoc.Count |> shouldEqual 1 + | _ -> failwith "odd symbol!" + + match x1FromProjectMultiProject with + | :? FSharpMemberOrFunctionOrValue as v -> v.XmlDoc.Count |> shouldEqual 1 + | _ -> failwith "odd symbol!" + + match ctorFromProjectMultiProject with + | :? FSharpMemberOrFunctionOrValue as c -> c.XmlDoc.Count |> shouldEqual 0 + | _ -> failwith "odd symbol!" + + match ctorFromProjectMultiProject with + | :? FSharpMemberOrFunctionOrValue as c -> c.EnclosingEntity.Value.XmlDoc.Count |> shouldEqual 1 + | _ -> failwith "odd symbol!" + + match case1FromProjectMultiProject with + | :? FSharpUnionCase as c -> c.XmlDoc.Count |> shouldEqual 1 + | _ -> failwith "odd symbol!" + //------------------------------------------------------------------------------------ @@ -742,7 +802,7 @@ let ``Test active patterns' XmlDocSig declared in referenced projects`` () = divisibleBySymbol.ToString() |> shouldEqual "symbol DivisibleBy" let divisibleByActivePatternCase = divisibleBySymbol :?> FSharpActivePatternCase - divisibleByActivePatternCase.XmlDoc |> Seq.toList |> shouldEqual [] + divisibleByActivePatternCase.XmlDoc |> Seq.toList |> shouldEqual [ "A parameterized active pattern of divisibility" ] divisibleByActivePatternCase.XmlDocSig |> shouldEqual "M:Project3A.|DivisibleBy|_|(System.Int32,System.Int32)" let divisibleByGroup = divisibleByActivePatternCase.Group divisibleByGroup.IsTotal |> shouldEqual false diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index f7510bb224..6a162ced54 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -1,5 +1,5 @@ #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" @@ -35,7 +35,8 @@ module internal Project1 = let fileNames = [ for (_,f) in fileNamesI -> f ] let args = mkProjectCommandLineArgs (dllName, fileNames) - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let parsingOptions, _ = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) [] @@ -47,7 +48,7 @@ let ``Test request for parse and check doesn't check whole project`` () = checker.FileParsed.Add (fun x -> incr backgroundParseCount) let pB, tB = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic - let parseResults1 = checker.ParseFileInProject(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.options) |> Async.RunSynchronously + let parseResults1 = checker.ParseFile(Project1.fileNames.[5], Project1.fileSources2.[5], Project1.parsingOptions) |> Async.RunSynchronously let pC, tC = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic (pC - pB) |> shouldEqual 1 (tC - tB) |> shouldEqual 0 diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 18da534dde..c09d8d4ca1 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -1,5 +1,5 @@ #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" @@ -87,7 +87,8 @@ let mmmm2 : M.CAbbrev = new M.CAbbrev() // note, these don't count as uses of C let fileNames = [fileName1; fileName2] let args = mkProjectCommandLineArgs (dllName, fileNames) - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let parsingOptions, _ = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) let cleanFileName a = if a = fileName1 then "file1" else if a = fileName2 then "file2" else "??" [] @@ -534,8 +535,8 @@ let ``Test file explicit parse symbols`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously - let parseResults1 = checker.ParseFileInProject(Project1.fileName1, Project1.fileSource1, Project1.options) |> Async.RunSynchronously - let parseResults2 = checker.ParseFileInProject(Project1.fileName2, Project1.fileSource2, Project1.options) |> Async.RunSynchronously + let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunSynchronously + let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunSynchronously let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileName1, 0, Project1.fileSource1, Project1.options) @@ -580,8 +581,8 @@ let ``Test file explicit parse all symbols`` () = let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously - let parseResults1 = checker.ParseFileInProject(Project1.fileName1, Project1.fileSource1, Project1.options) |> Async.RunSynchronously - let parseResults2 = checker.ParseFileInProject(Project1.fileName2, Project1.fileSource2, Project1.options) |> Async.RunSynchronously + let parseResults1 = checker.ParseFile(Project1.fileName1, Project1.fileSource1, Project1.parsingOptions) |> Async.RunSynchronously + let parseResults2 = checker.ParseFile(Project1.fileName2, Project1.fileSource2, Project1.parsingOptions) |> Async.RunSynchronously let checkResults1 = checker.CheckFileInProject(parseResults1, Project1.fileName1, 0, Project1.fileSource1, Project1.options) @@ -4532,26 +4533,26 @@ let ``Test project35b Dependency files for ParseAndCheckFileInProject`` () = | _ -> failwithf "Parsing aborted unexpectedly..." for d in checkFileResults.DependencyFiles do printfn "ParseAndCheckFileInProject dependency: %s" d - checkFileResults.DependencyFiles |> List.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true + checkFileResults.DependencyFiles |> Array.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true // The file itself is not a dependency since it is never read from the file system when using ParseAndCheckFileInProject - checkFileResults.DependencyFiles |> List.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual false + checkFileResults.DependencyFiles |> Array.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual false [] let ``Test project35b Dependency files for GetBackgroundCheckResultsForFileInProject`` () = let _,checkFileResults = checker.GetBackgroundCheckResultsForFileInProject(Project35b.fileName1, Project35b.options) |> Async.RunSynchronously for d in checkFileResults.DependencyFiles do printfn "GetBackgroundCheckResultsForFileInProject dependency: %s" d - checkFileResults.DependencyFiles |> List.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true + checkFileResults.DependencyFiles |> Array.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true // The file is a dependency since it is read from the file system when using GetBackgroundCheckResultsForFileInProject - checkFileResults.DependencyFiles |> List.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual true + checkFileResults.DependencyFiles |> Array.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual true [] let ``Test project35b Dependency files for check of project`` () = let checkResults = checker.ParseAndCheckProject(Project35b.options) |> Async.RunSynchronously for d in checkResults.DependencyFiles do printfn "ParseAndCheckProject dependency: %s" d - checkResults.DependencyFiles |> List.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true - checkResults.DependencyFiles |> List.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual true + checkResults.DependencyFiles |> Array.exists (fun s -> s.Contains "notexist.dll") |> shouldEqual true + checkResults.DependencyFiles |> Array.exists (fun s -> s.Contains Project35b.fileName1) |> shouldEqual true //------------------------------------------------------ @@ -5012,7 +5013,8 @@ module internal ProjectBig = let fileNames = [ for (_,f) in fileNamesI -> f ] let args = mkProjectCommandLineArgs (dllName, fileNames) - let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + let parsingOptions, _ = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args) [] @@ -5025,7 +5027,7 @@ let ``Test request for parse and check doesn't check whole project`` () = checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() let pB, tB = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic - let parseResults1 = checker.ParseFileInProject(ProjectBig.fileNames.[5], ProjectBig.fileSources2.[5], ProjectBig.options) |> Async.RunSynchronously + let parseResults1 = checker.ParseFile(ProjectBig.fileNames.[5], ProjectBig.fileSources2.[5], ProjectBig.parsingOptions) |> Async.RunSynchronously let pC, tC = FSharpChecker.GlobalForegroundParseCountStatistic, FSharpChecker.GlobalForegroundTypeCheckCountStatistic (pC - pB) |> shouldEqual 1 (tC - tB) |> shouldEqual 0 @@ -5174,3 +5176,45 @@ let ``Test line directives in foreground analysis`` () = // see https://github.c [ for e in checkResults1.Errors -> e.StartLineAlternate, e.EndLineAlternate, e.FileName ] |> shouldEqual [(4, 4, ProjectLineDirectives.fileName1)] +//------------------------------------------------------ + +[] +let ``ParseAndCheckFileResults contains ImplFile list if FSharpChecker is created with keepAssemblyContent flag set to true``() = + + let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs") + let base2 = Path.GetTempFileName() + let dllName = Path.ChangeExtension(base2, ".dll") + let projFileName = Path.ChangeExtension(base2, ".fsproj") + let fileSource1 = """ +type A(i:int) = + member x.Value = i +""" + File.WriteAllText(fileName1, fileSource1) + + let fileNames = [fileName1] + let args = mkProjectCommandLineArgs (dllName, fileNames) + let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true) + let options = keepAssemblyContentsChecker.GetProjectOptionsFromCommandLineArgs (projFileName, args) + + let fileCheckResults = + keepAssemblyContentsChecker.ParseAndCheckFileInProject(fileName1, 0, fileSource1, options) |> Async.RunSynchronously + |> function + | _, FSharpCheckFileAnswer.Succeeded(res) -> res + | _ -> failwithf "Parsing aborted unexpectedly..." + + let declarations = + match fileCheckResults.ImplementationFiles with + | Some (implFile :: _) -> + match implFile.Declarations |> List.tryHead with + | Some (FSharpImplementationFileDeclaration.Entity (_, subDecls)) -> subDecls + | _ -> failwith "unexpected declaration" + | Some [] | None -> failwith "File check results does not contain any `ImplementationFile`s" + + match declarations |> List.tryHead with + | Some (FSharpImplementationFileDeclaration.Entity(entity, [])) -> + entity.DisplayName |> shouldEqual "A" + let memberNames = entity.MembersFunctionsAndValues |> Seq.map (fun x -> x.DisplayName) |> Set.ofSeq + Assert.That(memberNames, Contains.Item "Value") + + | Some decl -> failwithf "unexpected declaration %A" decl + | None -> failwith "declaration list is empty" diff --git a/tests/service/ProjectOptionsTests.fs b/tests/service/ProjectOptionsTests.fs index 7595d0b08b..4fddf734b6 100644 --- a/tests/service/ProjectOptionsTests.fs +++ b/tests/service/ProjectOptionsTests.fs @@ -1,5 +1,5 @@ #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../Debug/net40/bin/FSharp.Compiler.Service.ProjectCracker.dll" #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" @@ -137,14 +137,19 @@ let ``Project file parsing -- compile files 2``() = [] let ``Project file parsing -- bad project file``() = let f = normalizePath (__SOURCE_DIRECTORY__ + @"/data/Malformed.fsproj") - let log = snd (ProjectCracker.GetProjectOptionsFromProjectFileLogged(f)) - log.[f] |> should contain "Microsoft.Build.Exceptions.InvalidProjectFileException" + try + ProjectCracker.GetProjectOptionsFromProjectFileLogged(f) |> ignore + failwith "Expected exception" + with e -> + Assert.That(e.Message, Contains.Substring "The project file could not be loaded.") [] let ``Project file parsing -- non-existent project file``() = let f = normalizePath (__SOURCE_DIRECTORY__ + @"/data/DoesNotExist.fsproj") - let log = snd (ProjectCracker.GetProjectOptionsFromProjectFileLogged(f, enableLogging=true)) - log.[f] |> should contain "System.IO.FileNotFoundException" + try + ProjectCracker.GetProjectOptionsFromProjectFileLogged(f, enableLogging=true) |> ignore + with e -> + Assert.That(e.Message, Contains.Substring "Could not find file") [] let ``Project file parsing -- output file``() = @@ -217,6 +222,19 @@ let ``Project file parsing -- Logging``() = else Assert.That(log, Is.StringContaining("""Using "ResolveAssemblyReference" task from assembly "Microsoft.Build.Tasks.Core, Version=14.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a".""")) +[] +let ``Project file parsing -- FSharpProjectOptions.SourceFiles contains both fs and fsi files``() = + let projectFileName = normalizePath (__SOURCE_DIRECTORY__ + @"/data/FsAndFsiFiles.fsproj") + let options, log = ProjectCracker.GetProjectOptionsFromProjectFileLogged(projectFileName, enableLogging=true) + printfn "%A" log + let expectedSourceFiles = + [| "Test1File2.fsi" + "Test1File2.fs" + "Test1File1.fs" + "Test1File0.fsi" + "Test1File0.fs" |] + Assert.That(options.SourceFiles |> Array.map Path.GetFileName, Is.EqualTo expectedSourceFiles, "source files") + [] let ``Project file parsing -- Full path``() = let f = normalizePath (__SOURCE_DIRECTORY__ + @"/data/ToolsVersion12.fsproj") diff --git a/tests/service/TokenizerTests.fs b/tests/service/TokenizerTests.fs index 105f55a202..1a9776c7a3 100644 --- a/tests/service/TokenizerTests.fs +++ b/tests/service/TokenizerTests.fs @@ -1,6 +1,6 @@  #if INTERACTIVE -#r "../../Debug/net40/bin/FSharp.Compiler.Service.dll" // note, run 'build fcs' to generate this, this DLL has a public API so can be used from F# Interactive +#r "../../Debug/fcs/net45/FSharp.Compiler.Service.dll" // note, run 'build fcs debug' to generate this, this DLL has a public API so can be used from F# Interactive #r "../../packages/NUnit.3.5.0/lib/net45/nunit.framework.dll" #load "FsUnit.fs" #load "Common.fs" diff --git a/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj b/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj index 5a43b0c04c..c63d10731d 100644 --- a/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj +++ b/tests/service/data/DifferingOutputDir/Dir1/Test1.fsproj @@ -48,7 +48,7 @@ - + diff --git a/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj b/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj index d426b46597..0ee82b31cb 100644 --- a/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj +++ b/tests/service/data/DifferingOutputDir/Dir2/Test2.fsproj @@ -54,7 +54,7 @@ Test1 - + diff --git a/tests/service/data/FsAndFsiFiles.fsproj b/tests/service/data/FsAndFsiFiles.fsproj new file mode 100644 index 0000000000..95b10fad1b --- /dev/null +++ b/tests/service/data/FsAndFsiFiles.fsproj @@ -0,0 +1,63 @@ + + + + Debug + x86 + 8.0.30703 + 2.0 + {116cc2f9-f987-4b3d-915a-34cac04a73da} + Library + Test1 + Test1 + bin\$(Configuration)\ + False + 11 + + + True + full + False + False + DEBUG;TRACE + 3 + x86 + bin\Debug\Test1.xml + + + pdbonly + True + True + TRACE + 3 + x86 + bin\Release\Test1.xml + False + + + + ..\..\..\packages\Microsoft.Portable.FSharp.Core.4.1.20\lib\profiles\net40\FSharp.Core.dll + + + + + + + + + + + + + + + + + + ..\..\..\packages\NUnit\lib\nunit.framework.dll + True + True + + + + + \ No newline at end of file diff --git a/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj b/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj index 7ab56a7734..e12ade0ff4 100644 --- a/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj +++ b/tests/service/data/MultiLanguageProject/ConsoleApplication1.fsproj @@ -64,7 +64,7 @@ 11 - + diff --git a/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj b/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj index cf8ada0c37..38bb936cab 100644 --- a/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj +++ b/tests/service/data/MultiLanguageProject/ConsoleApplication2.fsproj @@ -56,7 +56,7 @@ True - + diff --git a/tests/service/data/Space in name.fsproj b/tests/service/data/Space in name.fsproj index 5e5f560714..ec67bc9742 100644 --- a/tests/service/data/Space in name.fsproj +++ b/tests/service/data/Space in name.fsproj @@ -52,7 +52,7 @@ Test1 - + diff --git a/tests/service/data/Test1.fsproj b/tests/service/data/Test1.fsproj index 853a0b25db..6cb171ba60 100644 --- a/tests/service/data/Test1.fsproj +++ b/tests/service/data/Test1.fsproj @@ -46,7 +46,7 @@ - + diff --git a/tests/service/data/Test2.fsproj b/tests/service/data/Test2.fsproj index 2ad04efa94..96ff7ac180 100644 --- a/tests/service/data/Test2.fsproj +++ b/tests/service/data/Test2.fsproj @@ -53,7 +53,7 @@ Test1 - + diff --git a/tests/service/data/TestProject/TestProject.fsproj b/tests/service/data/TestProject/TestProject.fsproj index c5ec5c4ff1..dde260ce99 100644 --- a/tests/service/data/TestProject/TestProject.fsproj +++ b/tests/service/data/TestProject/TestProject.fsproj @@ -56,7 +56,7 @@ True - + diff --git a/tests/service/data/ToolsVersion12.fsproj b/tests/service/data/ToolsVersion12.fsproj index 6ed8fdc84a..92bad59c13 100644 --- a/tests/service/data/ToolsVersion12.fsproj +++ b/tests/service/data/ToolsVersion12.fsproj @@ -43,7 +43,7 @@ 11 - + diff --git a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj b/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj index 4f3ea153d8..6b50e360a0 100644 --- a/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj +++ b/tests/service/data/TypeProviderConsole/TypeProviderConsole.fsproj @@ -56,7 +56,7 @@ True - + diff --git a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj index ae00627aba..baa89f49b3 100644 --- a/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj +++ b/tests/service/data/TypeProviderLibrary/TypeProviderLibrary.fsproj @@ -44,5 +44,5 @@ - + \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj b/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj index 9af97c851b..54448fef5c 100644 --- a/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj +++ b/tests/service/data/TypeProvidersBug/TestConsole/TestConsole.fsproj @@ -60,5 +60,5 @@ True - + \ No newline at end of file diff --git a/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj b/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj index ab086df6a3..00ef54f652 100644 --- a/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj +++ b/tests/service/data/TypeProvidersBug/TypeProvidersBug/TypeProvidersBug.fsproj @@ -50,5 +50,5 @@ True - + \ No newline at end of file diff --git a/tests/service/data/sqlite-net-spike/sqlite-net-spike.fsproj b/tests/service/data/sqlite-net-spike/sqlite-net-spike.fsproj index 6d980b1e49..93cc75f002 100644 --- a/tests/service/data/sqlite-net-spike/sqlite-net-spike.fsproj +++ b/tests/service/data/sqlite-net-spike/sqlite-net-spike.fsproj @@ -47,7 +47,7 @@ - + diff --git a/vsintegration/Utils/LanguageServiceProfiling/Program.fs b/vsintegration/Utils/LanguageServiceProfiling/Program.fs index a64218f3e4..bc785b787c 100644 --- a/vsintegration/Utils/LanguageServiceProfiling/Program.fs +++ b/vsintegration/Utils/LanguageServiceProfiling/Program.fs @@ -156,7 +156,8 @@ let main argv = let! fileResults = checkFile fileVersion match fileResults with | Some fileResults -> - let! parseResult = checker.ParseFileInProject(options.FileToCheck, getFileText(), options.Options) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions(options.Options) + let! parseResult = checker.ParseFile(options.FileToCheck, getFileText(), parsingOptions) for completion in options.CompletionPositions do eprintfn "querying %A %s" completion.QualifyingNames completion.PartialName let! listInfo = diff --git a/vsintegration/Vsix/RegisterFsharpPackage.pkgdef b/vsintegration/Vsix/RegisterFsharpPackage.pkgdef index 156ece7c23..ec8375a91b 100644 --- a/vsintegration/Vsix/RegisterFsharpPackage.pkgdef +++ b/vsintegration/Vsix/RegisterFsharpPackage.pkgdef @@ -58,7 +58,7 @@ "CompanyName"="Microsoft Corp." [$RootKey$\Menus] -"{91a04a73-4f2c-4e7c-ad38-c1a68e7da05c}"=", 1000.ctmenu, 1" +"{91a04a73-4f2c-4e7c-ad38-c1a68e7da05c}"=", 1000_ctmenu, 1" [$RootKey$\CLSID\{e1194663-db3c-49eb-8b45-276fcdc440ea}] "InprocServer32"="$WinDir$\SYSTEM32\MSCOREE.DLL" diff --git a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest index ef14e8a858..a2cf49d9d2 100644 --- a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest +++ b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest @@ -4,7 +4,7 @@ Visual F# Tools - Deploy Visual F# Tools templates to Visual Studio + Deploy Visual F# Tools Binaries to Visual Studio Microsoft.FSharp.VSIX.Full.Core https://docs.microsoft.com/en-us/dotnet/articles/fsharp/ @@ -44,21 +44,6 @@ - - - - - - - - - - - - - - - diff --git a/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj index 97218f9922..336b501285 100644 --- a/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj +++ b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj @@ -207,129 +207,12 @@ DebugSymbolsProjectOutputGroup%3b True - - {6ba13aa4-c25f-480f-856b-8e8000299a72} - AppConfig - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {12ac2813-e895-4aaa-ae6c-94e21da09f64} - CodeFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {0385564F-07B4-4264-AB8A-17C393E9140C} - ResourceFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {a333b85a-dc23-49b6-9797-b89a7951e92d} - ScriptFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {e3fdd4ac-46b6-4b9f-b672-317d1202cc50} - SignatureFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {d11fc318-8f5d-4c8c-9287-ab40a016d13c} - TextFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {1fb1dd07-06aa-45b4-b5ac-20ff5bee98b6} - XMLFile - ItemTemplates - TemplateProjectOutputGroup%3b - false - True - - - {604f0daa-2d33-48dd-b162-edf0b672803d} - ConsoleProject - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {01678cda-a11f-4dee-9344-2edf91cf1ae7} - LibraryProject - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {d9d95330-3626-4199-b7af-17b8e4af6d87} - NetCore259Project - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {1a8dbf70-4178-4ae3-af5f-39ddd5692210} - NetCore78Project - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {5b739cf3-1116-4eb4-b598-6c16bea81ce5} - NetCoreProject - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {db374a0c-7560-479f-9b21-d37c81f7624f} - PortableLibraryProject - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - - - {2facee44-48bd-40b5-a2ee-b54a0c9bb7c4} - TutorialProject - ProjectTemplates - TemplateProjectOutputGroup%3b - false - True - False $(FSharpSourcesRoot)\..\packages\Newtonsoft.Json.10.0.2\lib\net45\Newtonsoft.Json.dll - - - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll - diff --git a/vsintegration/Vsix/VisualFSharpOpenSource/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpOpenSource/Source.extension.vsixmanifest index d3ddf295f0..c60aa24979 100644 --- a/vsintegration/Vsix/VisualFSharpOpenSource/Source.extension.vsixmanifest +++ b/vsintegration/Vsix/VisualFSharpOpenSource/Source.extension.vsixmanifest @@ -4,7 +4,7 @@ Visual F# Tools - Deploy Visual F# Tools templates to Visual Studio + Deploy Visual F# Tools Binaries and Templates to Visual Studio Microsoft.FSharp.VSIX.OpenSource.Core https://docs.microsoft.com/en-us/dotnet/articles/fsharp/ @@ -28,7 +28,6 @@ - - diff --git a/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj b/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj index de084fad4f..c0bd76dc75 100644 --- a/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj +++ b/vsintegration/Vsix/VisualFSharpOpenSource/VisualFSharpOpenSource.csproj @@ -324,10 +324,8 @@ False $(FSharpSourcesRoot)\..\packages\Newtonsoft.Json.10.0.2\lib\net45\Newtonsoft.Json.dll - - - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.3.1\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll diff --git a/vsintegration/Vsix/VisualFSharpTemplates/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpTemplates/Source.extension.vsixmanifest new file mode 100644 index 0000000000..cdf2919404 --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpTemplates/Source.extension.vsixmanifest @@ -0,0 +1,39 @@ + + + + + + + Visual F# Templates + Deploy Visual F# Tools Templates to Visual Studio + Microsoft.FSharp.VSIX.Templates + https://docs.microsoft.com/en-us/dotnet/articles/fsharp/ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vsintegration/Vsix/VisualFSharpTemplates/VisualFSharpTemplates.csproj b/vsintegration/Vsix/VisualFSharpTemplates/VisualFSharpTemplates.csproj new file mode 100644 index 0000000000..addf142025 --- /dev/null +++ b/vsintegration/Vsix/VisualFSharpTemplates/VisualFSharpTemplates.csproj @@ -0,0 +1,218 @@ + + + + + $(MSBuildProjectDirectory)\..\..\..\src + net40 + 15.0 + 11.0 + $(FSharpSourcesRoot)\..\packages\Microsoft.VSSDK.BuildTools.$(RoslynVSPackagesVersion)\tools + + 15.0 + 2.0 + {82b43b9b-a64c-4715-b499-d71e9ca2bd60};{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC} + + publish\ + true + Disk + false + Foreground + 7 + Days + true + false + true + 0 + v4.6 + false + false + false + false + false + false + false + false + true + true + CommonExtensions + Microsoft\FSharp + None + Debug + AnyCPU + Library + Properties + RoslynDev + true + False + True + {385035C1-9171-408A-8EAA-67DDC14E2CF3} + true + VisualFSharpTemplate + $(FSharpSourcesRoot)\..\$(Configuration)\$(TargetDotnetProfile)\bin + VisualFSharpTemplate + $(RootBinPath) + 15.4.1.0 + cs + false + + + Program + $(DevEnvDir)devenv.exe + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + true + + + Program + $(DevEnvDir)devenv.exe + true + /rootsuffix $(VSRootSuffix) /log + $(VSRootSuffix) + + + + Designer + + + + + False + Microsoft .NET Framework 4.6 %28x86 and x64%29 + true + + + False + .NET Framework 3.5 SP1 Client Profile + false + + + False + .NET Framework 3.5 SP1 + false + + + + + {6ba13aa4-c25f-480f-856b-8e8000299a72} + AppConfig + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {12ac2813-e895-4aaa-ae6c-94e21da09f64} + CodeFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {0385564F-07B4-4264-AB8A-17C393E9140C} + ResourceFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {a333b85a-dc23-49b6-9797-b89a7951e92d} + ScriptFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {e3fdd4ac-46b6-4b9f-b672-317d1202cc50} + SignatureFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {d11fc318-8f5d-4c8c-9287-ab40a016d13c} + TextFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {1fb1dd07-06aa-45b4-b5ac-20ff5bee98b6} + XMLFile + ItemTemplates + TemplateProjectOutputGroup%3b + false + True + + + {604f0daa-2d33-48dd-b162-edf0b672803d} + ConsoleProject + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {01678cda-a11f-4dee-9344-2edf91cf1ae7} + LibraryProject + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {d9d95330-3626-4199-b7af-17b8e4af6d87} + NetCore259Project + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {1a8dbf70-4178-4ae3-af5f-39ddd5692210} + NetCore78Project + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {5b739cf3-1116-4eb4-b598-6c16bea81ce5} + NetCoreProject + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {db374a0c-7560-479f-9b21-d37c81f7624f} + PortableLibraryProject + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + {2facee44-48bd-40b5-a2ee-b54a0c9bb7c4} + TutorialProject + ProjectTemplates + TemplateProjectOutputGroup%3b + false + True + + + + + + + + + VsixSHA2 + + + + diff --git a/vsintegration/fsharp-vsintegration-vsix-build.proj b/vsintegration/fsharp-vsintegration-vsix-build.proj index 48039b6896..518b3639eb 100644 --- a/vsintegration/fsharp-vsintegration-vsix-build.proj +++ b/vsintegration/fsharp-vsintegration-vsix-build.proj @@ -6,6 +6,7 @@ + diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs index 38c6eacc76..806c54b0b3 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs @@ -140,7 +140,7 @@ module internal ClassificationDefinitions = type internal FSharpFunctionTypeFormat() as self = inherit ClassificationFormatDefinition() - do self.DisplayName <- SR.FSharpFunctionsOrMethodsClassificationType.Value + do self.DisplayName <- SR.FSharpFunctionsOrMethodsClassificationType() [)>] [] @@ -150,7 +150,7 @@ module internal ClassificationDefinitions = type internal FSharpMutableVarTypeFormat [](theme: ThemeColors) as self = inherit ClassificationFormatDefinition() - do self.DisplayName <- SR.FSharpMutableVarsClassificationType.Value + do self.DisplayName <- SR.FSharpMutableVarsClassificationType() self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.MutableVar [)>] @@ -161,7 +161,7 @@ module internal ClassificationDefinitions = type internal FSharpPrintfTypeFormat [](theme: ThemeColors) as self = inherit ClassificationFormatDefinition() - do self.DisplayName <- SR.FSharpPrintfFormatClassificationType.Value + do self.DisplayName <- SR.FSharpPrintfFormatClassificationType() self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.Printf [)>] @@ -172,7 +172,7 @@ module internal ClassificationDefinitions = type internal FSharpPropertyFormat() as self = inherit ClassificationFormatDefinition() - do self.DisplayName <- SR.FSharpPropertiesClassificationType.Value + do self.DisplayName <- SR.FSharpPropertiesClassificationType() [)>] [] @@ -182,5 +182,5 @@ module internal ClassificationDefinitions = type internal FSharpDisposableFormat [](theme: ThemeColors) as self = inherit ClassificationFormatDefinition() - do self.DisplayName <- SR.FSharpDisposablesClassificationType.Value + do self.DisplayName <- SR.FSharpDisposablesClassificationType() self.ForegroundColor <- theme.GetColor FSharpClassificationTypes.Disposable \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Classification/ColorizationService.fs b/vsintegration/src/FSharp.Editor/Classification/ColorizationService.fs index b40aaa4d0a..b60ee3b9bc 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ColorizationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ColorizationService.fs @@ -40,9 +40,9 @@ type internal FSharpColorizationService asyncMaybe { do Trace.TraceInformation("{0:n3} (start) SemanticColorization", DateTime.Now.TimeOfDay.TotalSeconds) do! Async.Sleep DefaultTuning.SemanticColorizationInitialDelay |> liftAsync // be less intrusive, give other work priority most of the time - let! options = projectInfoManager.TryGetOptionsForDocumentOrProject(document) + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) + let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) // it's crucial to not return duplicated or overlapping `ClassifiedSpan`s because Find Usages service crashes. let targetRange = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText) let colorizationData = checkResults.GetSemanticClassification (Some targetRange) |> Array.distinctBy fst diff --git a/vsintegration/src/FSharp.Editor/CodeFix/AddNewKeywordToDisposableConstructorInvocation.fs b/vsintegration/src/FSharp.Editor/CodeFix/AddNewKeywordToDisposableConstructorInvocation.fs index ac295302dc..0253a220ae 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/AddNewKeywordToDisposableConstructorInvocation.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/AddNewKeywordToDisposableConstructorInvocation.fs @@ -19,7 +19,7 @@ type internal FSharpAddNewKeywordCodeFixProvider() = override this.RegisterCodeFixesAsync context : Task = async { - let title = SR.AddNewKeyword.Value + let title = SR.AddNewKeyword() context.RegisterCodeFix( CodeAction.Create( title, diff --git a/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs b/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs index 92622f4fe7..76f88464e7 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs @@ -96,12 +96,12 @@ type internal FSharpAddOpenCodeFixProvider override __.RegisterCodeFixesAsync context : Task = asyncMaybe { let document = context.Document - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document let! sourceText = context.Document.GetTextAsync(context.CancellationToken) - let! _, parsedInput, checkResults = checker.ParseAndCheckDocument(document, options, allowStaleResults = true, sourceText = sourceText, userOpName = userOpName) + let! _, parsedInput, checkResults = checker.ParseAndCheckDocument(document, projectOptions, allowStaleResults = true, sourceText = sourceText, userOpName = userOpName) let line = sourceText.Lines.GetLineFromPosition(context.Span.End) let linePos = sourceText.Lines.GetLinePosition(context.Span.End) - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) let! symbol = asyncMaybe { diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs b/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs index 494f071ad5..5cf5fcba21 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs @@ -130,8 +130,8 @@ type internal FSharpImplementInterfaceCodeFixProvider title) context.RegisterCodeFix(codeAction, diagnostics) - registerCodeFix SR.ImplementInterface.Value true - registerCodeFix SR.ImplementInterfaceWithoutTypeAnnotation.Value false + registerCodeFix (SR.ImplementInterface()) true + registerCodeFix (SR.ImplementInterfaceWithoutTypeAnnotation()) false else () @@ -139,12 +139,12 @@ type internal FSharpImplementInterfaceCodeFixProvider override __.RegisterCodeFixesAsync context : Task = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject context.Document + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject context.Document let cancellationToken = context.CancellationToken let! sourceText = context.Document.GetTextAsync(cancellationToken) - let! _, parsedInput, checkFileResults = checker.ParseAndCheckDocument(context.Document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) + let! _, parsedInput, checkFileResults = checker.ParseAndCheckDocument(context.Document, projectOptions, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) let textLine = sourceText.Lines.GetLineFromPosition context.Span.Start - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(context.Document.FilePath, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(context.Document.FilePath, parsingOptions) // Notice that context.Span doesn't return reliable ranges to find tokens at exact positions. // That's why we tokenize the line and try to find the last successive identifier token let tokens = Tokenizer.tokenizeLine(context.Document.Id, sourceText, context.Span.Start, context.Document.FilePath, defines) diff --git a/vsintegration/src/FSharp.Editor/CodeFix/MissingReferenceCodeFixProvider.fs b/vsintegration/src/FSharp.Editor/CodeFix/MissingReferenceCodeFixProvider.fs index efa9e2f14d..91bfc716b1 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/MissingReferenceCodeFixProvider.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/MissingReferenceCodeFixProvider.fs @@ -71,7 +71,7 @@ type internal MissingReferenceCodeFixProvider() = | Some refProject -> let codefix = createCodeFix( - String.Format(SR.AddProjectReference.Value, refProject.Name), + String.Format(SR.AddProjectReference(), refProject.Name), context, AddProjectRef (ProjectReference refProject.Id) ) @@ -90,7 +90,7 @@ type internal MissingReferenceCodeFixProvider() = | Some metadataRef -> let codefix = createCodeFix( - String.Format(SR.AddAssemblyReference.Value, assemblyName), + String.Format(SR.AddAssemblyReference(), assemblyName), context, AddMetadataRef metadataRef ) diff --git a/vsintegration/src/FSharp.Editor/CodeFix/RemoveUnusedOpens.fs b/vsintegration/src/FSharp.Editor/CodeFix/RemoveUnusedOpens.fs index 1bbab71834..5e97220d08 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/RemoveUnusedOpens.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/RemoveUnusedOpens.fs @@ -32,8 +32,8 @@ type internal FSharpRemoveUnusedOpensCodeFixProvider let document = context.Document let! sourceText = document.GetTextAsync() let checker = checkerProvider.Checker - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) - let! unusedOpens = UnusedOpensDiagnosticAnalyzer.GetUnusedOpenRanges(document, options, checker) + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! unusedOpens = UnusedOpensDiagnosticAnalyzer.GetUnusedOpenRanges(document, projectOptions, checker) let changes = unusedOpens |> List.map (fun m -> @@ -52,7 +52,7 @@ type internal FSharpRemoveUnusedOpensCodeFixProvider override __.RegisterCodeFixesAsync context : Task = async { let diagnostics = context.Diagnostics |> Seq.filter (fun x -> fixableDiagnosticIds |> List.contains x.Id) |> Seq.toImmutableArray - context.RegisterCodeFix(createCodeFix(SR.RemoveUnusedOpens.Value, context), diagnostics) + context.RegisterCodeFix(createCodeFix(SR.RemoveUnusedOpens(), context), diagnostics) } |> RoslynHelpers.StartAsyncUnitAsTask(context.CancellationToken) override __.GetFixAllProvider() = WellKnownFixAllProviders.BatchFixer diff --git a/vsintegration/src/FSharp.Editor/CodeFix/RenameUnusedValue.fs b/vsintegration/src/FSharp.Editor/CodeFix/RenameUnusedValue.fs index 3cb96a95e1..710bd2244c 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/RenameUnusedValue.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/RenameUnusedValue.fs @@ -54,10 +54,10 @@ type internal FSharpRenameUnusedValueCodeFixProvider // We have to use the additional check for backtickes because `IsOperatorOrBacktickedName` operates on display names // where backtickes are replaced with parens. if not (PrettyNaming.IsOperatorOrBacktickedName ident) && not (ident.StartsWith "``") then - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document - let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, allowStaleResults = true, sourceText = sourceText, userOpName=userOpName) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document + let! _, _, checkResults = checker.ParseAndCheckDocument(document, projectOptions, allowStaleResults = true, sourceText = sourceText, userOpName=userOpName) let m = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, context.Span, sourceText) - let defines = CompilerEnvironment.GetCompilationDefinesForEditing (document.FilePath, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing (document.FilePath, parsingOptions) let! lexerSymbol = Tokenizer.getSymbolAtPosition (document.Id, sourceText, context.Span.Start, document.FilePath, defines, SymbolLookupKind.Greedy, false) let lineText = (sourceText.Lines.GetLineFromPosition context.Span.Start).ToString() let! symbolUse = checkResults.GetSymbolUseAtLocation(m.StartLine, m.EndColumn, lineText, lexerSymbol.FullIsland, userOpName=userOpName) @@ -65,12 +65,12 @@ type internal FSharpRenameUnusedValueCodeFixProvider match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as func -> - createCodeFix(context, symbolName, SR.PrefixValueNameWithUnderscore.Value, TextChange(TextSpan(context.Span.Start, 0), "_")) + createCodeFix(context, symbolName, SR.PrefixValueNameWithUnderscore(), TextChange(TextSpan(context.Span.Start, 0), "_")) if func.IsMemberThisValue then - createCodeFix(context, symbolName, SR.RenameValueToDoubleUnderscore.Value, TextChange(context.Span, "__")) + createCodeFix(context, symbolName, SR.RenameValueToDoubleUnderscore(), TextChange(context.Span, "__")) elif not func.IsMember then - createCodeFix(context, symbolName, SR.RenameValueToUnderscore.Value, TextChange(context.Span, "_")) + createCodeFix(context, symbolName, SR.RenameValueToUnderscore(), TextChange(context.Span, "_")) | _ -> () } |> Async.Ignore diff --git a/vsintegration/src/FSharp.Editor/CodeFix/SimplifyName.fs b/vsintegration/src/FSharp.Editor/CodeFix/SimplifyName.fs index 2b727c8fc2..152cce0682 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/SimplifyName.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/SimplifyName.fs @@ -24,8 +24,8 @@ type internal FSharpSimplifyNameCodeFixProvider() = for diagnostic in context.Diagnostics |> Seq.filter (fun x -> x.Id = fixableDiagnosticId) do let title = match diagnostic.Properties.TryGetValue(SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey) with - | true, longIdent -> sprintf "%s '%s'" SR.SimplifyName.Value longIdent - | _ -> SR.SimplifyName.Value + | true, longIdent -> sprintf "%s '%s'" (SR.SimplifyName()) longIdent + | _ -> SR.SimplifyName() let codefix = createTextChangeCodeFix(title, context, (fun () -> asyncMaybe.Return [| TextChange(context.Span, "") |])) diff --git a/vsintegration/src/FSharp.Editor/Commands/HelpContextService.fs b/vsintegration/src/FSharp.Editor/Commands/HelpContextService.fs index 2c7ece3013..99bcd091c9 100644 --- a/vsintegration/src/FSharp.Editor/Commands/HelpContextService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/HelpContextService.fs @@ -99,13 +99,13 @@ type internal FSharpHelpContextService member this.GetHelpTermAsync(document, textSpan, cancellationToken) = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) let! textVersion = document.GetTextVersionAsync(cancellationToken) let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) let textLine = sourceText.Lines.GetLineFromPosition(textSpan.Start) let tokens = Tokenizer.getColorizationData(document.Id, sourceText, textLine.Span, Some document.Name, defines, cancellationToken) - return! FSharpHelpContextService.GetHelpTerm(checkerProvider.Checker, sourceText, document.FilePath, options, textSpan, tokens, textVersion.GetHashCode()) + return! FSharpHelpContextService.GetHelpTerm(checkerProvider.Checker, sourceText, document.FilePath, projectOptions, textSpan, tokens, textVersion.GetHashCode()) } |> Async.map (Option.defaultValue "") |> RoslynHelpers.StartAsyncAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs index 2af8950656..9d5c2990ae 100644 --- a/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs +++ b/vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs @@ -67,9 +67,9 @@ type internal XmlDocCommandFilter // XmlDocable line #1 are 1-based, editor is 0-based let curLineNum = wpfTextView.Caret.Position.BufferPosition.GetContainingLine().LineNumber + 1 let! document = document.Value - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let sourceText = wpfTextView.TextBuffer.CurrentSnapshot.GetText() - let! parsedInput = checker.ParseDocument(document, options, sourceText, userOpName) + let! parsedInput = checker.ParseDocument(document, parsingOptions, sourceText, userOpName) let xmlDocables = XmlDocParser.getXmlDocables (sourceText, Some parsedInput) let xmlDocablesBelowThisLine = // +1 because looking below current line for e.g. a 'member' diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index f77988f270..e30c0322b4 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -210,15 +210,15 @@ type internal FSharpCompletionProvider let! sourceText = context.Document.GetTextAsync(context.CancellationToken) let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) do! Option.guard (CompletionUtils.shouldProvideCompletion(document.Id, document.FilePath, defines, sourceText, context.Position)) - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! textVersion = context.Document.GetTextVersionAsync(context.CancellationToken) - let! _, _, fileCheckResults = checker.ParseAndCheckDocument(document, options, true, userOpName=userOpName) + let! _, _, fileCheckResults = checker.ParseAndCheckDocument(document, projectOptions, true, userOpName=userOpName) let getAllSymbols() = if Settings.IntelliSense.ShowAllSymbols then assemblyContentProvider.GetAllEntitiesInProjectAndReferencedAssemblies(fileCheckResults) else [] let! results = - FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, sourceText, context.Position, options, + FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, sourceText, context.Position, projectOptions, document.FilePath, textVersion.GetHashCode(), getAllSymbols) context.AddItems(results) } |> Async.Ignore |> RoslynHelpers.StartAsyncUnitAsTask context.CancellationToken @@ -268,8 +268,8 @@ type internal FSharpCompletionProvider let! sourceText = document.GetTextAsync(cancellationToken) let textWithItemCommitted = sourceText.WithChanges(TextChange(item.Span, nameInCode)) let line = sourceText.Lines.GetLineFromPosition(item.Span.Start) - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) - let! parsedInput = checker.ParseDocument(document, options, sourceText, userOpName) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsedInput = checker.ParseDocument(document, parsingOptions, sourceText, userOpName) let fullNameIdents = fullName |> Option.map (fun x -> x.Split '.') |> Option.defaultValue [||] let insertionPoint = diff --git a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs index 22310a9bf4..852fa7bfd5 100644 --- a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs +++ b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs @@ -196,7 +196,7 @@ type internal FSharpSignatureHelpProvider member this.GetItemsAsync(document, position, triggerInfo, cancellationToken) = asyncMaybe { try - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) let! textVersion = document.GetTextVersionAsync(cancellationToken) @@ -206,7 +206,7 @@ type internal FSharpSignatureHelpProvider else None let! (results,applicableSpan,argumentIndex,argumentCount,argumentName) = - FSharpSignatureHelpProvider.ProvideMethodsAsyncAux(checkerProvider.Checker, documentationBuilder, sourceText, position, options, triggerTypedChar, document.FilePath, textVersion.GetHashCode()) + FSharpSignatureHelpProvider.ProvideMethodsAsyncAux(checkerProvider.Checker, documentationBuilder, sourceText, position, projectOptions, triggerTypedChar, document.FilePath, textVersion.GetHashCode()) let items = results |> Array.map (fun (hasParamArrayArg, doc, prefixParts, separatorParts, suffixParts, parameters, descriptionParts) -> diff --git a/vsintegration/src/FSharp.Editor/Debugging/BreakpointResolutionService.fs b/vsintegration/src/FSharp.Editor/Debugging/BreakpointResolutionService.fs index 864a77e44a..97bf920d70 100644 --- a/vsintegration/src/FSharp.Editor/Debugging/BreakpointResolutionService.fs +++ b/vsintegration/src/FSharp.Editor/Debugging/BreakpointResolutionService.fs @@ -27,13 +27,8 @@ type internal FSharpBreakpointResolutionService ) = static let userOpName = "BreakpointResolution" - static member GetBreakpointLocation(checker: FSharpChecker, sourceText: SourceText, fileName: string, textSpan: TextSpan, options: FSharpProjectOptions) = + static member GetBreakpointLocation(checker: FSharpChecker, sourceText: SourceText, fileName: string, textSpan: TextSpan, parsingOptions: FSharpParsingOptions) = async { - // REVIEW: ParseFileInProject can cause FSharp.Compiler.Service to become unavailable (i.e. not responding to requests) for - // an arbitrarily long time while it parses all files prior to this one in the project (plus dependent projects if we enable - // cross-project checking in multi-project solutions). FCS will not respond to other - // requests unless this task is cancelled. We need to check that this task is cancelled in a timely way by the - // Roslyn UI machinery. let textLinePos = sourceText.Lines.GetLinePosition(textSpan.Start) let textInLine = sourceText.GetSubText(sourceText.Lines.[textLinePos.Line].Span).ToString() @@ -42,16 +37,16 @@ type internal FSharpBreakpointResolutionService else let textLineColumn = textLinePos.Character let fcsTextLineNumber = Line.fromZ textLinePos.Line // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based - let! parseResults = checker.ParseFileInProject(fileName, sourceText.ToString(), options, userOpName = userOpName) + let! parseResults = checker.ParseFile(fileName, sourceText.ToString(), parsingOptions, userOpName = userOpName) return parseResults.ValidateBreakpointLocation(mkPos fcsTextLineNumber textLineColumn) } interface IBreakpointResolutionService with member this.ResolveBreakpointAsync(document: Document, textSpan: TextSpan, cancellationToken: CancellationToken): Task = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let! range = FSharpBreakpointResolutionService.GetBreakpointLocation(checkerProvider.Checker, sourceText, document.Name, textSpan, options) + let! range = FSharpBreakpointResolutionService.GetBreakpointLocation(checkerProvider.Checker, sourceText, document.Name, textSpan, parsingOptions) let! span = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) return BreakpointResolutionResult.CreateSpanResult(document, span) } diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs index 412496efa3..ffcf5c6ef8 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs @@ -57,9 +57,9 @@ type internal FSharpDocumentDiagnosticAnalyzer() = hash } - static member GetDiagnostics(checker: FSharpChecker, filePath: string, sourceText: SourceText, textVersionHash: int, options: FSharpProjectOptions, diagnosticType: DiagnosticsType) = + static member GetDiagnostics(checker: FSharpChecker, filePath: string, sourceText: SourceText, textVersionHash: int, parsingOptions: FSharpParsingOptions, options: FSharpProjectOptions, diagnosticType: DiagnosticsType) = async { - let! parseResults = checker.ParseFileInProject(filePath, sourceText.ToString(), options, userOpName=userOpName) + let! parseResults = checker.ParseFile(filePath, sourceText.ToString(), parsingOptions, userOpName=userOpName) let! errors = async { match diagnosticType with @@ -109,11 +109,11 @@ type internal FSharpDocumentDiagnosticAnalyzer() = override this.AnalyzeSyntaxAsync(document: Document, cancellationToken: CancellationToken): Task> = let projectInfoManager = getProjectInfoManager document asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) let! textVersion = document.GetTextVersionAsync(cancellationToken) return! - FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(getChecker document, document.FilePath, sourceText, textVersion.GetHashCode(), options, DiagnosticsType.Syntax) + FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(getChecker document, document.FilePath, sourceText, textVersion.GetHashCode(), parsingOptions, projectOptions, DiagnosticsType.Syntax) |> liftAsync } |> Async.map (Option.defaultValue ImmutableArray.Empty) @@ -122,11 +122,11 @@ type internal FSharpDocumentDiagnosticAnalyzer() = override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken): Task> = let projectInfoManager = getProjectInfoManager document asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForDocumentOrProject(document) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) let! textVersion = document.GetTextVersionAsync(cancellationToken) return! - FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(getChecker document, document.FilePath, sourceText, textVersion.GetHashCode(), options, DiagnosticsType.Semantic) + FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(getChecker document, document.FilePath, sourceText, textVersion.GetHashCode(), parsingOptions, projectOptions, DiagnosticsType.Semantic) |> liftAsync } |> Async.map (Option.defaultValue ImmutableArray.Empty) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 0686c7ddd8..b0b25ca6ea 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -34,8 +34,8 @@ type internal SimplifyNameDiagnosticAnalyzer() = static let Descriptor = DiagnosticDescriptor( id = IDEDiagnosticIds.SimplifyNamesDiagnosticId, - title = SR.SimplifyName.Value, - messageFormat = SR.NameCanBeSimplified.Value, + title = SR.SimplifyName(), + messageFormat = SR.NameCanBeSimplified(), category = DiagnosticCategory.Style, defaultSeverity = DiagnosticSeverity.Hidden, isEnabledByDefault = true, @@ -51,7 +51,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.SimplifyName do Trace.TraceInformation("{0:n3} (start) SimplifyName", DateTime.Now.TimeOfDay.TotalSeconds) do! Async.Sleep DefaultTuning.SimplifyNameInitialDelay |> liftAsync - let! options = getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) + let! _parsingOptions, projectOptions = getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) let! textVersion = document.GetTextVersionAsync(cancellationToken) let textVersionHash = textVersion.GetHashCode() let! _ = guard.WaitAsync(cancellationToken) |> Async.AwaitTask |> liftAsync @@ -61,7 +61,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = | _ -> let! sourceText = document.GetTextAsync() let checker = getChecker document - let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName=userOpName) + let! _, _, checkResults = checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = true, userOpName=userOpName) let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync let mutable result = ResizeArray() let symbolUses = diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs index b1868f9f5f..cb541cac32 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedDeclarationsAnalyzer.fs @@ -24,8 +24,8 @@ type internal UnusedDeclarationsAnalyzer() = let Descriptor = DiagnosticDescriptor( id = DescriptorId, - title = SR.TheValueIsUnused.Value, - messageFormat = SR.TheValueIsUnused.Value, + title = SR.TheValueIsUnused(), + messageFormat = SR.TheValueIsUnused(), category = DiagnosticCategory.Style, defaultSeverity = DiagnosticSeverity.Hidden, isEnabledByDefault = true, @@ -103,10 +103,10 @@ type internal UnusedDeclarationsAnalyzer() = do Trace.TraceInformation("{0:n3} (start) UnusedDeclarationsAnalyzer", DateTime.Now.TimeOfDay.TotalSeconds) do! Async.Sleep DefaultTuning.UnusedDeclarationsAnalyzerInitialDelay |> liftAsync // be less intrusive, give other work priority most of the time match getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) with - | Some options -> + | Some (_parsingOptions, projectOptions) -> let! sourceText = document.GetTextAsync() let checker = getChecker document - let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) + let! _, _, checkResults = checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) let! allSymbolUsesInFile = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync let unusedRanges = getUnusedDeclarationRanges allSymbolUsesInFile (isScriptFile document.FilePath) return diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 53c5d51b3d..0dcb5c9da5 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -150,8 +150,8 @@ type internal UnusedOpensDiagnosticAnalyzer() = static let Descriptor = DiagnosticDescriptor( id = IDEDiagnosticIds.RemoveUnnecessaryImportsDiagnosticId, - title = SR.RemoveUnusedOpens.Value, - messageFormat = SR.UnusedOpens.Value, + title = SR.RemoveUnusedOpens(), + messageFormat = SR.UnusedOpens(), category = DiagnosticCategory.Style, defaultSeverity = DiagnosticSeverity.Hidden, isEnabledByDefault = true, @@ -173,10 +173,10 @@ type internal UnusedOpensDiagnosticAnalyzer() = asyncMaybe { do Trace.TraceInformation("{0:n3} (start) UnusedOpensAnalyzer", DateTime.Now.TimeOfDay.TotalSeconds) do! Async.Sleep DefaultTuning.UnusedOpensAnalyzerInitialDelay |> liftAsync // be less intrusive, give other work priority most of the time - let! options = getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) + let! _parsingOptions, projectOptions = getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync() let checker = getChecker document - let! unusedOpens = UnusedOpensDiagnosticAnalyzer.GetUnusedOpenRanges(document, options, checker) + let! unusedOpens = UnusedOpensDiagnosticAnalyzer.GetUnusedOpenRanges(document, projectOptions, checker) return unusedOpens diff --git a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs index 435152abd5..db616ba510 100644 --- a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs +++ b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs @@ -198,7 +198,7 @@ module internal XmlDocumentation = if not started then started <- true AppendHardLine collector - AppendOnNewLine collector SR.ExceptionsLabel.Value + AppendOnNewLine collector (SR.ExceptionsHeader()) EnsureHardLine collector collector.Add(tagSpace " ") WriteTypeName collector exnType.Value @@ -349,7 +349,7 @@ module internal XmlDocumentation = let ProcessGenericParameters (tps: Layout list) = if not tps.IsEmpty then AppendHardLine typeParameterMapCollector - AppendOnNewLine typeParameterMapCollector SR.GenericParametersLabel.Value + AppendOnNewLine typeParameterMapCollector (SR.GenericParametersHeader()) for tp in tps do AppendHardLine typeParameterMapCollector typeParameterMapCollector.Add(tagSpace " ") diff --git a/vsintegration/src/FSharp.Editor/DocumentHighlights/DocumentHighlightsService.fs b/vsintegration/src/FSharp.Editor/DocumentHighlights/DocumentHighlightsService.fs index e4829fd476..354c41759d 100644 --- a/vsintegration/src/FSharp.Editor/DocumentHighlights/DocumentHighlightsService.fs +++ b/vsintegration/src/FSharp.Editor/DocumentHighlights/DocumentHighlightsService.fs @@ -76,12 +76,12 @@ type internal FSharpDocumentHighlightsService [] (checkerP interface IDocumentHighlightsService with member __.GetDocumentHighlightsAsync(document, position, _documentsToSearch, cancellationToken) : Task> = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) let! textVersion = document.GetTextVersionAsync(cancellationToken) - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) let! spans = FSharpDocumentHighlightsService.GetDocumentHighlights(checkerProvider.Checker, document.Id, sourceText, document.FilePath, - position, defines, options, textVersion.GetHashCode()) + position, defines, projectOptions, textVersion.GetHashCode()) let highlightSpans = spans |> Array.map (fun span -> diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.Attributes.fs b/vsintegration/src/FSharp.Editor/FSharp.Editor.Attributes.fs new file mode 100644 index 0000000000..0852f72ab4 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.Attributes.fs @@ -0,0 +1,33 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor + +//-------------------------------------------------------------------------------------- +// Attributes used to mark up editable properties + +[] +type internal SRDescriptionAttribute(description:string) = + inherit DescriptionAttribute(description) + let mutable replaced = false + + override x.Description = + if not (replaced) then + replaced <- true + x.DescriptionValue <- SR.GetString(base.Description) + base.Description + +[] +type internal SRCategoryAttribute(category:string) = + inherit CategoryAttribute(category) + override x.GetLocalizedString(value:string) = SR.GetString(value) + +[] +type internal SRDisplayNameAttribute(name:string) = + inherit DisplayNameAttribute() + + override x.DisplayName = + match SR.GetString(name) with + | null -> + Debug.Assert(false, "String resource '" + name + "' is missing") + name + | result -> result diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index ae38f48257..bde8237c08 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -29,8 +29,9 @@ true - - + + Microsoft.VisualStudio.FSharp.Editor.SR + @@ -267,7 +268,7 @@ True - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True diff --git a/vsintegration/src/FSharp.Editor/Formatting/BraceMatchingService.fs b/vsintegration/src/FSharp.Editor/Formatting/BraceMatchingService.fs index 700768a20c..7b795f0cc8 100644 --- a/vsintegration/src/FSharp.Editor/Formatting/BraceMatchingService.fs +++ b/vsintegration/src/FSharp.Editor/Formatting/BraceMatchingService.fs @@ -18,9 +18,9 @@ type internal FSharpBraceMatchingService static let defaultUserOpName = "BraceMatching" - static member GetBraceMatchingResult(checker: FSharpChecker, sourceText, fileName, options, position: int, userOpName: string) = + static member GetBraceMatchingResult(checker: FSharpChecker, sourceText, fileName, parsingOptions: FSharpParsingOptions, position: int, userOpName: string) = async { - let! matchedBraces = checker.MatchBraces(fileName, sourceText.ToString(), options, userOpName) + let! matchedBraces = checker.MatchBraces(fileName, sourceText.ToString(), parsingOptions, userOpName) let isPositionInRange range = match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with | None -> false @@ -33,9 +33,9 @@ type internal FSharpBraceMatchingService interface IBraceMatcher with member this.FindBracesAsync(document, position, cancellationToken) = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let! (left, right) = FSharpBraceMatchingService.GetBraceMatchingResult(checkerProvider.Checker, sourceText, document.Name, options, position, defaultUserOpName) + let! (left, right) = FSharpBraceMatchingService.GetBraceMatchingResult(checkerProvider.Checker, sourceText, document.Name, parsingOptions, position, defaultUserOpName) let! leftSpan = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, left) let! rightSpan = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, right) return BraceMatchingResult(leftSpan, rightSpan) diff --git a/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs b/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs index 0abbd0abdd..d4b1b24ebf 100644 --- a/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs +++ b/vsintegration/src/FSharp.Editor/Formatting/EditorFormattingService.fs @@ -23,7 +23,7 @@ type internal FSharpEditorFormattingService projectInfoManager: FSharpProjectOptionsManager ) = - static member GetFormattingChanges(documentId: DocumentId, sourceText: SourceText, filePath: string, checker: FSharpChecker, indentStyle: FormattingOptions.IndentStyle, projectOptions: FSharpProjectOptions option, position: int) = + static member GetFormattingChanges(documentId: DocumentId, sourceText: SourceText, filePath: string, checker: FSharpChecker, indentStyle: FormattingOptions.IndentStyle, options: (FSharpParsingOptions * FSharpProjectOptions) option, position: int) = // Logic for determining formatting changes: // If first token on the current line is a closing brace, // match the indent with the indent on the line that opened it @@ -34,11 +34,11 @@ type internal FSharpEditorFormattingService // (this is what C# does) do! Option.guard (indentStyle = FormattingOptions.IndentStyle.Smart) - let! projectOptions = projectOptions + let! parsingOptions, _projectOptions = options let line = sourceText.Lines.[sourceText.Lines.IndexOf position] - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(filePath, projectOptions.OtherOptions |> List.ofArray) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(filePath, parsingOptions) let tokens = Tokenizer.tokenizeLine(documentId, sourceText, line.Start, filePath, defines) @@ -50,7 +50,7 @@ type internal FSharpEditorFormattingService x.Tag <> FSharpTokenTag.LINE_COMMENT) let! (left, right) = - FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, filePath, projectOptions, position, "FormattingService") + FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, filePath, parsingOptions, position, "FormattingService") if right.StartColumn = firstMeaningfulToken.LeftColumn then // Replace the indentation on this line with the indentation of the left bracket diff --git a/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs b/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs index 4fa71c024f..23afe5131c 100644 --- a/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs +++ b/vsintegration/src/FSharp.Editor/Formatting/IndentationService.fs @@ -23,7 +23,7 @@ type internal FSharpIndentationService static member IsSmartIndentEnabled (options: Microsoft.CodeAnalysis.Options.OptionSet) = options.GetOption(FormattingOptions.SmartIndent, FSharpConstants.FSharpLanguageName) = FormattingOptions.IndentStyle.Smart - static member GetDesiredIndentation(documentId: DocumentId, sourceText: SourceText, filePath: string, lineNumber: int, tabSize: int, indentStyle: FormattingOptions.IndentStyle, projectOptions: FSharpProjectOptions option): Option = + static member GetDesiredIndentation(documentId: DocumentId, sourceText: SourceText, filePath: string, lineNumber: int, tabSize: int, indentStyle: FormattingOptions.IndentStyle, options: (FSharpParsingOptions * FSharpProjectOptions) option): Option = // Match indentation with previous line let rec tryFindPreviousNonEmptyLine l = @@ -36,8 +36,8 @@ type internal FSharpIndentationService tryFindPreviousNonEmptyLine (l - 1) let rec tryFindLastNonWhitespaceOrCommentToken (line: TextLine) = maybe { - let! projectOptions = projectOptions - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(filePath, projectOptions.OtherOptions |> Seq.toList) + let! parsingOptions, _projectOptions = options + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(filePath, parsingOptions) let tokens = Tokenizer.tokenizeLine(documentId, sourceText, line.Start, filePath, defines) return! diff --git a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs index d2f804ebe5..89e9d6a8f2 100644 --- a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs +++ b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs @@ -167,10 +167,10 @@ type internal InlineRenameService interface IEditorInlineRenameService with member __.GetRenameInfoAsync(document: Document, position: int, cancellationToken: CancellationToken) : Task = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) - return! InlineRenameService.GetInlineRenameInfo(checkerProvider.Checker, projectInfoManager, document, sourceText, position, defines, options) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) + return! InlineRenameService.GetInlineRenameInfo(checkerProvider.Checker, projectInfoManager, document, sourceText, position, defines, projectOptions) } |> Async.map (Option.defaultValue FailureInlineRenameInfo.Instance) |> RoslynHelpers.StartAsyncAsTask(cancellationToken) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs index 7eb2616f28..2d6b877fee 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerExtensions.fs @@ -15,14 +15,14 @@ type CheckResults = | StillRunning of Async<(FSharpParseFileResults * FSharpCheckFileResults) option> type FSharpChecker with - member checker.ParseDocument(document: Document, options: FSharpProjectOptions, sourceText: string, userOpName: string) = + member checker.ParseDocument(document: Document, parsingOptions: FSharpParsingOptions, sourceText: string, userOpName: string) = asyncMaybe { - let! fileParseResults = checker.ParseFileInProject(document.FilePath, sourceText, options, userOpName=userOpName) |> liftAsync + let! fileParseResults = checker.ParseFile(document.FilePath, sourceText, parsingOptions, userOpName=userOpName) |> liftAsync return! fileParseResults.ParseTree } - member checker.ParseDocument(document: Document, options: FSharpProjectOptions, sourceText: SourceText, userOpName: string) = - checker.ParseDocument(document, options, sourceText=sourceText.ToString(), userOpName=userOpName) + member checker.ParseDocument(document: Document, parsingOptions: FSharpParsingOptions, sourceText: SourceText, userOpName: string) = + checker.ParseDocument(document, parsingOptions, sourceText=sourceText.ToString(), userOpName=userOpName) member checker.ParseAndCheckDocument(filePath: string, textVersionHash: int, sourceText: string, options: FSharpProjectOptions, allowStaleResults: bool, userOpName: string) = let parseAndCheckFile = diff --git a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs index 04beb527f3..238325be41 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs @@ -101,11 +101,11 @@ type internal FSharpProjectOptionsManager ) = // A table of information about projects, excluding single-file projects. - let projectTable = ConcurrentDictionary>() + let projectTable = ConcurrentDictionary>() // A table of information about single-file projects. Currently we only need the load time of each such file, plus // the original options for editing - let singleFileProjectTable = ConcurrentDictionary() + let singleFileProjectTable = ConcurrentDictionary() // Accumulate sources and references for each project file let projectInfo = new ConcurrentDictionary() @@ -128,7 +128,7 @@ type internal FSharpProjectOptionsManager member this.RefreshInfoForProjectsThatReferenceThisProject(projectId: ProjectId) = // Search the projectTable for things to refresh - for KeyValue(otherProjectId, ((referencedProjectIds, _options), refresh)) in projectTable.ToArray() do + for KeyValue(otherProjectId, ((referencedProjectIds, _parsingOptions, _options), refresh)) in projectTable.ToArray() do for referencedProjectId in referencedProjectIds do if referencedProjectId = projectId then projectTable.[otherProjectId] <- (refresh true, refresh) @@ -143,7 +143,7 @@ type internal FSharpProjectOptionsManager /// Get the exact options for a single-file script member this.ComputeSingleFileOptions (tryGetOrCreateProjectId, fileName, loadTime, fileContents, workspace: Workspace) = async { let extraProjectInfo = Some(box workspace) - let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject + let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject |> Option.map snd if SourceFile.MustBeSingleFileProject(fileName) then // NOTE: we don't use a unique stamp for single files, instead comparing options structurally. // This is because we repeatedly recompute the options. @@ -153,37 +153,42 @@ type internal FSharpProjectOptionsManager // compiled and #r will refer to files on disk let referencedProjectFileNames = [| |] let site = ProjectSitesAndFiles.CreateProjectSiteForScript(fileName, referencedProjectFileNames, options) - return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject,site,fileName,options.ExtraProjectInfo,serviceProvider, true) + let deps, projectOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject,site,fileName,options.ExtraProjectInfo,serviceProvider, true) + let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) + return (deps, parsingOptions, projectOptions) else let site = ProjectSitesAndFiles.ProjectSiteOfSingleFile(fileName) - return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject,site,fileName,extraProjectInfo,serviceProvider, true) + let deps, projectOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject,site,fileName,extraProjectInfo,serviceProvider, true) + let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) + return (deps, parsingOptions, projectOptions) } /// Update the info for a project in the project table member this.UpdateProjectInfo(tryGetOrCreateProjectId, projectId: ProjectId, site: IProjectSite, userOpName) = this.AddOrUpdateProject(projectId, (fun isRefresh -> let extraProjectInfo = Some(box workspace) - let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject - let referencedProjects, options = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject, site, site.ProjectFileName, extraProjectInfo, serviceProvider, true) + let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject |> Option.map snd + let referencedProjects, projectOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(Settings.LanguageServicePerformance.EnableInMemoryCrossProjectReferences, tryGetOptionsForReferencedProject, site, site.ProjectFileName, extraProjectInfo, serviceProvider, true) let referencedProjectIds = referencedProjects |> Array.choose tryGetOrCreateProjectId - checkerProvider.Checker.InvalidateConfiguration(options, startBackgroundCompileIfAlreadySeen = not isRefresh, userOpName= userOpName + ".UpdateProjectInfo") - referencedProjectIds, options)) + checkerProvider.Checker.InvalidateConfiguration(projectOptions, startBackgroundCompileIfAlreadySeen = not isRefresh, userOpName= userOpName + ".UpdateProjectInfo") + let parsingOptions, _ = checkerProvider.Checker.GetParsingOptionsFromProjectOptions(projectOptions) + referencedProjectIds, parsingOptions, projectOptions)) /// Get compilation defines relevant for syntax processing. /// Quicker then TryGetOptionsForDocumentOrProject as it doesn't need to recompute the exact project /// options for a script. member this.GetCompilationDefinesForEditingDocument(document: Document) = let projectOptionsOpt = this.TryGetOptionsForProject(document.Project.Id) - let otherOptions = + let parsingOptions = match projectOptionsOpt with - | None -> [] - | Some options -> options.OtherOptions |> Array.toList - CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, otherOptions) + | None -> FSharpParsingOptions.Default + | Some (parsingOptions, _projectOptions) -> parsingOptions + CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) /// Get the options for a project member this.TryGetOptionsForProject(projectId: ProjectId) = match projectTable.TryGetValue(projectId) with - | true, ((_referencedProjects, options), _) -> Some options + | true, ((_referencedProjects, parsingOptions, projectOptions), _) -> Some (parsingOptions, projectOptions) | _ -> None /// Get the exact options for a document or project @@ -194,7 +199,7 @@ type internal FSharpProjectOptionsManager // single-file project may contain #load and #r references which are changing as the user edits, and we may need to re-analyze // to determine the latest settings. FCS keeps a cache to help ensure these are up-to-date. match singleFileProjectTable.TryGetValue(projectId) with - | true, (loadTime, _) -> + | true, (loadTime, _, _) -> try let fileName = document.FilePath let! cancellationToken = Async.CancellationToken @@ -202,9 +207,9 @@ type internal FSharpProjectOptionsManager // NOTE: we don't use FCS cross-project references from scripts to projects. The projects must have been // compiled and #r will refer to files on disk. let tryGetOrCreateProjectId _ = None - let! _referencedProjectFileNames, options = this.ComputeSingleFileOptions (tryGetOrCreateProjectId, fileName, loadTime, sourceText.ToString(), document.Project.Solution.Workspace) - this.AddOrUpdateSingleFileProject(projectId, (loadTime, options)) - return Some options + let! _referencedProjectFileNames, parsingOptions, projectOptions = this.ComputeSingleFileOptions (tryGetOrCreateProjectId, fileName, loadTime, sourceText.ToString(), document.Project.Solution.Workspace) + this.AddOrUpdateSingleFileProject(projectId, (loadTime, parsingOptions, projectOptions)) + return Some (parsingOptions, projectOptions) with ex -> Assert.Exception(ex) return None @@ -216,7 +221,7 @@ type internal FSharpProjectOptionsManager member this.TryGetOptionsForEditingDocumentOrProject(document: Document) = let projectId = document.Project.Id match singleFileProjectTable.TryGetValue(projectId) with - | true, (_loadTime, originalOptions) -> Some originalOptions + | true, (_loadTime, parsingOptions, originalOptions) -> Some (parsingOptions, originalOptions) | _ -> this.TryGetOptionsForProject(projectId) member this.ProvideProjectSiteProvider(project:Project) = @@ -302,6 +307,8 @@ type internal FSharpProjectOptionsManager | true, value -> value | _ -> [||], [||], [||] + member __.Checker = checkerProvider.Checker + // Used to expose FSharpChecker/ProjectInfo manager to diagnostic providers // Diagnostic providers can be executed in environment that does not use MEF so they can rely only // on services exposed by the workspace @@ -586,8 +593,8 @@ type let projectDisplayName = projectDisplayNameOf projectFileName let projectId = workspace.ProjectTracker.GetOrCreateProjectIdForPath(projectFileName, projectDisplayName) - let _referencedProjectFileNames, options = projectInfoManager.ComputeSingleFileOptions (tryGetOrCreateProjectId workspace, fileName, loadTime, fileContents, workspace) |> Async.RunSynchronously - projectInfoManager.AddOrUpdateSingleFileProject(projectId, (loadTime, options)) + let _referencedProjectFileNames, parsingOptions, projectOptions = projectInfoManager.ComputeSingleFileOptions (tryGetOrCreateProjectId workspace, fileName, loadTime, fileContents, workspace) |> Async.RunSynchronously + projectInfoManager.AddOrUpdateSingleFileProject(projectId, (loadTime, parsingOptions, projectOptions)) if isNull (workspace.ProjectTracker.GetProject projectId) then let projectContextFactory = package.ComponentModel.GetService(); diff --git a/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs b/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs index dfe76098b8..15995d015f 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs @@ -30,10 +30,10 @@ module internal SymbolHelpers = let textLine = sourceText.Lines.GetLineFromPosition(position) let textLinePos = sourceText.Lines.GetLinePosition(position) let fcsTextLineNumber = Line.fromZ textLinePos.Line - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) let! symbol = Tokenizer.getSymbolAtPosition(document.Id, sourceText, position, document.FilePath, defines, SymbolLookupKind.Greedy, false) - let! _, _, checkFileResults = checker.ParseAndCheckDocument(document.FilePath, textVersionHash, sourceText.ToString(), options, allowStaleResults = true, userOpName = userOpName) + let! _, _, checkFileResults = checker.ParseAndCheckDocument(document.FilePath, textVersionHash, sourceText.ToString(), projectOptions, allowStaleResults = true, userOpName = userOpName) let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.Ident.idRange.EndColumn, textLine.ToString(), symbol.FullIsland, userOpName=userOpName) let! symbolUses = checkFileResults.GetUsesOfSymbolInFile(symbolUse.Symbol) |> liftAsync return symbolUses @@ -59,8 +59,8 @@ module internal SymbolHelpers = |> Seq.map (fun project -> async { match projectInfoManager.TryGetOptionsForProject(project.Id) with - | Some options -> - let! projectCheckResults = checker.ParseAndCheckProject(options, userOpName = userOpName) + | Some (_parsingOptions, projectOptions) -> + let! projectCheckResults = checker.ParseAndCheckProject(projectOptions, userOpName = userOpName) return! projectCheckResults.GetUsesOfSymbol(symbol) | None -> return [||] }) @@ -103,10 +103,10 @@ module internal SymbolHelpers = let! sourceText = document.GetTextAsync(cancellationToken) let originalText = sourceText.ToString(symbolSpan) do! Option.guard (originalText.Length > 0) - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, parsingOptions) let! symbol = Tokenizer.getSymbolAtPosition(document.Id, sourceText, symbolSpan.Start, document.FilePath, defines, SymbolLookupKind.Greedy, false) - let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, options, allowStaleResults = true, userOpName = userOpName) + let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, projectOptions, allowStaleResults = true, userOpName = userOpName) let textLine = sourceText.Lines.GetLineFromPosition(symbolSpan.Start) let textLinePos = sourceText.Lines.GetLinePosition(symbolSpan.Start) let fcsTextLineNumber = Line.fromZ textLinePos.Line diff --git a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs index b964f1d2ef..e3479737db 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs @@ -51,11 +51,11 @@ type internal FSharpFindUsagesService asyncMaybe { let! sourceText = document.GetTextAsync(context.CancellationToken) |> Async.AwaitTask |> liftAsync let checker = checkerProvider.Checker - let! options = projectInfoManager.TryGetOptionsForDocumentOrProject(document) - let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document) + let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) let textLine = sourceText.Lines.GetLineFromPosition(position).ToString() let lineNumber = sourceText.Lines.GetLinePosition(position).Line + 1 - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.FilePath, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.FilePath, parsingOptions) let! symbol = Tokenizer.getSymbolAtPosition(document.Id, sourceText, position, document.FilePath, defines, SymbolLookupKind.Greedy, false) let! symbolUse = checkFileResults.GetSymbolUseAtLocation(lineNumber, symbol.Ident.idRange.EndColumn, textLine, symbol.FullIsland, userOpName=userOpName) @@ -112,8 +112,8 @@ type internal FSharpFindUsagesService projectsToCheck |> Seq.map (fun project -> asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForProject(project.Id) - let! projectCheckResults = checker.ParseAndCheckProject(options, userOpName = userOpName) |> liftAsync + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForProject(project.Id) + let! projectCheckResults = checker.ParseAndCheckProject(projectOptions, userOpName = userOpName) |> liftAsync return! projectCheckResults.GetUsesOfSymbol(symbolUse.Symbol) |> liftAsync } |> Async.map (Option.defaultValue [||])) |> Async.Parallel diff --git a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs index 9b7b12aecd..7707b8a255 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs @@ -57,8 +57,8 @@ type internal GoToDefinition(checker: FSharpChecker, projectInfoManager: FSharpP /// Helper function that is used to determine the navigation strategy to apply, can be tuned towards signatures or implementation files. let findSymbolHelper (originDocument: Document, originRange: range, sourceText: SourceText, preferSignature: bool) : Async = asyncMaybe { - let! projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject originDocument - let defines = CompilerEnvironment.GetCompilationDefinesForEditing (originDocument.FilePath, projectOptions.OtherOptions |> Seq.toList) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject originDocument + let defines = CompilerEnvironment.GetCompilationDefinesForEditing (originDocument.FilePath, parsingOptions) let! originTextSpan = RoslynHelpers.TryFSharpRangeToTextSpan (sourceText, originRange) let position = originTextSpan.Start let! lexerSymbol = Tokenizer.getSymbolAtPosition (originDocument.Id, sourceText, position, originDocument.FilePath, defines, SymbolLookupKind.Greedy, false) @@ -67,7 +67,7 @@ type internal GoToDefinition(checker: FSharpChecker, projectInfoManager: FSharpP let fcsTextLineNumber = Line.fromZ textLinePos.Line let lineText = (sourceText.Lines.GetLineFromPosition position).ToString() - let! _, _, checkFileResults = checker.ParseAndCheckDocument (originDocument,projectOptions,allowStaleResults=true,sourceText=sourceText, userOpName = userOpName) + let! _, _, checkFileResults = checker.ParseAndCheckDocument (originDocument, projectOptions, allowStaleResults=true,sourceText=sourceText, userOpName = userOpName) let idRange = lexerSymbol.Ident.idRange let! fsSymbolUse = checkFileResults.GetSymbolUseAtLocation (fcsTextLineNumber, idRange.EndColumn, lineText, lexerSymbol.FullIsland, userOpName=userOpName) let symbol = fsSymbolUse.Symbol @@ -79,7 +79,7 @@ type internal GoToDefinition(checker: FSharpChecker, projectInfoManager: FSharpP if not (File.Exists fsfilePath) then return! None else let! implDoc = originDocument.Project.Solution.TryGetDocumentFromPath fsfilePath let! implSourceText = implDoc.GetTextAsync () - let! projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject implDoc + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject implDoc let! _, _, checkFileResults = checker.ParseAndCheckDocument (implDoc, projectOptions, allowStaleResults=true, sourceText=implSourceText, userOpName = userOpName) let! symbolUses = checkFileResults.GetUsesOfSymbolInFile symbol |> liftAsync let! implSymbol = symbolUses |> Array.tryHead @@ -252,7 +252,7 @@ type internal FSharpGoToDefinitionService match navigableItem with | Some navigableItem -> - statusBar.Message SR.NavigatingTo.Value + statusBar.Message (SR.NavigatingTo()) let workspace = navigableItem.Document.Project.Solution.Workspace let navigationService = workspace.Services.GetService() @@ -263,11 +263,11 @@ type internal FSharpGoToDefinitionService if result then statusBar.Clear() else - statusBar.TempMessage SR.CannotNavigateUnknown.Value + statusBar.TempMessage (SR.CannotNavigateUnknown()) result | None -> - statusBar.TempMessage SR.CannotDetermineSymbol.Value + statusBar.TempMessage (SR.CannotDetermineSymbol()) true /// Navigate to the positon of the textSpan in the provided document @@ -280,7 +280,7 @@ type internal FSharpGoToDefinitionService if navigationService.TryNavigateToSpan (workspace, navigableItem.Document.Id, navigableItem.SourceSpan, options) then true else - statusBar.TempMessage SR.CannotNavigateUnknown.Value + statusBar.TempMessage (SR.CannotNavigateUnknown()) false /// find the declaration location (signature file/.fsi) of the target symbol if possible, fall back to definition @@ -295,9 +295,9 @@ type internal FSharpGoToDefinitionService /// at the provided position in the document. member __.FindDefinitionsTask(originDocument: Document, position: int, cancellationToken: CancellationToken) = asyncMaybe { - let! projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject originDocument + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject originDocument let! sourceText = originDocument.GetTextAsync () |> liftTaskAsync - let defines = CompilerEnvironment.GetCompilationDefinesForEditing (originDocument.FilePath, projectOptions.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing (originDocument.FilePath, parsingOptions) let textLine = sourceText.Lines.GetLineFromPosition position let textLinePos = sourceText.Lines.GetLinePosition position let fcsTextLineNumber = Line.fromZ textLinePos.Line @@ -382,7 +382,7 @@ type internal FSharpGoToDefinitionService let! implDocument = originDocument.Project.Solution.TryGetDocumentFromPath implFilePath let! implVersion = implDocument.GetTextVersionAsync () |> liftTaskAsync let! implSourceText = implDocument.GetTextAsync () |> liftTaskAsync - let! projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject implDocument + let! _parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject implDocument let! targetRange = gotoDefinition.FindSymbolDeclarationInFile(targetSymbolUse, implFilePath, implSourceText.ToString(), projectOptions, implVersion.GetHashCode()) @@ -405,7 +405,7 @@ type internal FSharpGoToDefinitionService member this.TryGoToDefinition(document: Document, position: int, cancellationToken: CancellationToken) = let definitionTask = this.FindDefinitionsTask (document, position, cancellationToken) - statusBar.Message SR.LocatingSymbol.Value + statusBar.Message (SR.LocatingSymbol()) use __ = statusBar.Animate() // Wrap this in a try/with as if the user clicks "Cancel" on the thread dialog, we'll be cancelled @@ -419,7 +419,7 @@ type internal FSharpGoToDefinitionService match completionError with | Some message -> - statusBar.TempMessage <| String.Format(SR.NavigateToFailed.Value, message) + statusBar.TempMessage <| String.Format(SR.NavigateToFailed(), message) // Don't show the dialog box as it's most likely that the user cancelled. // Don't make them click twice. @@ -439,5 +439,5 @@ type internal FSharpGoToDefinitionService // presenter.DisplayResult(navigableItem.DisplayString, definitionTask.Result) //true else - statusBar.TempMessage SR.CannotDetermineSymbol.Value + statusBar.TempMessage (SR.CannotDetermineSymbol()) false \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs index d84202eac7..a1cee3bff4 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/NavigateToSearchService.fs @@ -187,11 +187,11 @@ type internal FSharpNavigateToSearchService let itemsByDocumentId = ConditionalWeakTable() - let getNavigableItems(document: Document, options: FSharpProjectOptions) = + let getNavigableItems(document: Document, parsingOptions: FSharpParsingOptions) = async { let! cancellationToken = Async.CancellationToken let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask - let! parseResults = checkerProvider.Checker.ParseFileInProject(document.FilePath, sourceText.ToString(), options) + let! parseResults = checkerProvider.Checker.ParseFile(document.FilePath, sourceText.ToString(), parsingOptions) return match parseResults.ParseTree |> Option.map NavigateTo.getNavigableItems with | Some items -> @@ -206,7 +206,7 @@ type internal FSharpNavigateToSearchService | None -> [||] } - let getCachedIndexedNavigableItems(document: Document, options: FSharpProjectOptions) = + let getCachedIndexedNavigableItems(document: Document, parsingOptions: FSharpParsingOptions) = async { let! cancellationToken = Async.CancellationToken let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask @@ -215,7 +215,7 @@ type internal FSharpNavigateToSearchService | true, (oldTextVersionHash, items) when oldTextVersionHash = textVersionHash -> return items | _ -> - let! items = getNavigableItems(document, options) + let! items = getNavigableItems(document, parsingOptions) let indexedItems = Index.build items itemsByDocumentId.Remove(document.Id) |> ignore itemsByDocumentId.Add(document.Id, (textVersionHash, indexedItems)) @@ -233,10 +233,10 @@ type internal FSharpNavigateToSearchService interface INavigateToSearchService with member __.SearchProjectAsync(project, searchPattern, cancellationToken) : Task> = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForProject(project.Id) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForProject(project.Id) let! items = project.Documents - |> Seq.map (fun document -> getCachedIndexedNavigableItems(document, options)) + |> Seq.map (fun document -> getCachedIndexedNavigableItems(document, parsingOptions)) |> Async.Parallel |> liftAsync @@ -265,8 +265,8 @@ type internal FSharpNavigateToSearchService member __.SearchDocumentAsync(document, searchPattern, cancellationToken) : Task> = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForDocumentOrProject(document) - let! items = getCachedIndexedNavigableItems(document, options) |> liftAsync + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForDocumentOrProject(document) + let! items = getCachedIndexedNavigableItems(document, parsingOptions) |> liftAsync return items.Find(searchPattern) } |> Async.map (Option.defaultValue [||]) diff --git a/vsintegration/src/FSharp.Editor/Navigation/NavigationBarItemService.fs b/vsintegration/src/FSharp.Editor/Navigation/NavigationBarItemService.fs index 7e0fdac0de..34fad074ba 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/NavigationBarItemService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/NavigationBarItemService.fs @@ -32,9 +32,9 @@ type internal FSharpNavigationBarItemService interface INavigationBarItemService with member __.GetItemsAsync(document, cancellationToken) : Task> = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let! parsedInput = checkerProvider.Checker.ParseDocument(document, options, sourceText=sourceText, userOpName=userOpName) + let! parsedInput = checkerProvider.Checker.ParseDocument(document, parsingOptions, sourceText=sourceText, userOpName=userOpName) let navItems = NavigationImpl.getNavigation parsedInput let rangeToTextSpan range = RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) return diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs index 1324602ffb..8e4a6fa82a 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs @@ -55,8 +55,8 @@ module private FSharpQuickInfo = let extLineText = (extSourceText.Lines.GetLineFromPosition extSpan.Start).ToString() // project options need to be retrieved because the signature file could be in another project - let! extProjectOptions = projectInfoManager.TryGetOptionsForProject extDocId.ProjectId - let extDefines = CompilerEnvironment.GetCompilationDefinesForEditing (extDocument.FilePath, List.ofSeq extProjectOptions.OtherOptions) + let! extParsingOptions, extProjectOptions = projectInfoManager.TryGetOptionsForProject extDocId.ProjectId + let extDefines = CompilerEnvironment.GetCompilationDefinesForEditing (extDocument.FilePath, extParsingOptions) let! extLexerSymbol = Tokenizer.getSymbolAtPosition(extDocId, extSourceText, extSpan.Start, declRange.FileName, extDefines, SymbolLookupKind.Greedy, true) let! _, _, extCheckFileResults = checker.ParseAndCheckDocument(extDocument, extProjectOptions, allowStaleResults=true, sourceText=extSourceText, userOpName = userOpName) @@ -91,8 +91,8 @@ module private FSharpQuickInfo = asyncMaybe { let! sourceText = document.GetTextAsync cancellationToken - let! projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document - let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.FilePath, projectOptions.OtherOptions |> Seq.toList) + let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.FilePath, parsingOptions) let! lexerSymbol = Tokenizer.getSymbolAtPosition(document.Id, sourceText, position, document.FilePath, defines, SymbolLookupKind.Greedy, true) let idRange = lexerSymbol.Ident.idRange let! _, _, checkFileResults = checker.ParseAndCheckDocument(document, projectOptions, allowStaleResults = true, sourceText=sourceText, userOpName = userOpName) @@ -170,12 +170,12 @@ type internal FSharpQuickInfoProvider let xmlMemberIndexService = serviceProvider.GetService(typeof) :?> IVsXMLMemberIndexService let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(xmlMemberIndexService, serviceProvider.DTE) - static member ProvideQuickInfo(checker: FSharpChecker, documentId: DocumentId, sourceText: SourceText, filePath: string, position: int, options: FSharpProjectOptions, textVersionHash: int) = + static member ProvideQuickInfo(checker: FSharpChecker, documentId: DocumentId, sourceText: SourceText, filePath: string, position: int, parsingOptions: FSharpParsingOptions, options: FSharpProjectOptions, textVersionHash: int) = asyncMaybe { let! _, _, checkFileResults = checker.ParseAndCheckDocument (filePath, textVersionHash, sourceText.ToString(), options, allowStaleResults = true, userOpName = FSharpQuickInfo.userOpName) let textLine = sourceText.Lines.GetLineFromPosition position let textLineNumber = textLine.LineNumber + 1 // Roslyn line numbers are zero-based - let defines = CompilerEnvironment.GetCompilationDefinesForEditing (filePath, options.OtherOptions |> Seq.toList) + let defines = CompilerEnvironment.GetCompilationDefinesForEditing (filePath, parsingOptions) let! symbol = Tokenizer.getSymbolAtPosition (documentId, sourceText, position, filePath, defines, SymbolLookupKind.Precise, true) let! res = checkFileResults.GetStructuredToolTipText (textLineNumber, symbol.Ident.idRange.EndColumn, textLine.ToString(), symbol.FullIsland, FSharpTokenTag.IDENT, userOpName=FSharpQuickInfo.userOpName) |> liftAsync match res with diff --git a/vsintegration/src/FSharp.Editor/Structure/BlockStructureService.fs b/vsintegration/src/FSharp.Editor/Structure/BlockStructureService.fs index 68a41f19e6..865165665a 100644 --- a/vsintegration/src/FSharp.Editor/Structure/BlockStructureService.fs +++ b/vsintegration/src/FSharp.Editor/Structure/BlockStructureService.fs @@ -148,9 +148,9 @@ type internal FSharpBlockStructureService(checker: FSharpChecker, projectInfoMan override __.GetBlockStructureAsync(document, cancellationToken) : Task = asyncMaybe { - let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) + let! parsingOptions, _options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document) let! sourceText = document.GetTextAsync(cancellationToken) - let! parsedInput = checker.ParseDocument(document, options, sourceText, userOpName) + let! parsedInput = checker.ParseDocument(document, parsingOptions, sourceText, userOpName) return createBlockSpans sourceText parsedInput |> Seq.toImmutableArray } |> Async.map (Option.defaultValue ImmutableArray<_>.Empty) diff --git a/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs b/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs deleted file mode 100644 index e2e64e3d69..0000000000 --- a/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs +++ /dev/null @@ -1,75 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor - -open System -open System.ComponentModel -open System.Diagnostics - -[] -module SR = - let private resources = lazy (new System.Resources.ResourceManager("FSharp.Editor", System.Reflection.Assembly.GetExecutingAssembly())) - - let GetString(name:string) = - let s = resources.Value.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) -#if DEBUG - if null = s then System.Diagnostics.Debug.Assert(false, sprintf "**RESOURCE ERROR**: Resource token %s does not exist!" name) -#endif - s.Replace(@"\n", System.Environment.NewLine) - - // Sigh!!!! We do this because at the moment we don't have a tool to generate the SR from a resx file - let AddNewKeyword = lazy ( GetString "AddNewKeyword" ) // "Add 'new' keyword" - let PrefixValueNameWithUnderscore = lazy ( GetString "PrefixValueNameWithUnderscore" ) // "Prefix value name with underscore" - let RenameValueToUnderscore = lazy ( GetString "RenameValueToUnderscore" ) // "Rename value to '_'" - let RenameValueToDoubleUnderscore = lazy ( GetString "RenameValueToDoubleUnderscore" ) // "Rename value to '__'" - let ImplementInterface = lazy ( GetString "ImplementInterface" ) - let ImplementInterfaceWithoutTypeAnnotation = lazy ( GetString "ImplementInterfaceWithoutTypeAnnotation" ) - let SimplifyName = lazy ( GetString "SimplifyName") - let NameCanBeSimplified = lazy ( GetString "NameCanBeSimplified") - let FSharpFunctionsOrMethodsClassificationType = lazy (GetString "FSharpFunctionsOrMethodsClassificationType") - let FSharpMutableVarsClassificationType = lazy (GetString "FSharpMutableVarsClassificationType") - let FSharpPrintfFormatClassificationType = lazy (GetString "FSharpPrintfFormatClassificationType") - let FSharpPropertiesClassificationType = lazy (GetString "FSharpPropertiesClassificationType") - let FSharpDisposablesClassificationType = lazy (GetString "FSharpDisposablesClassificationType") - let TheValueIsUnused = lazy (GetString "TheValueIsUnused") - let RemoveUnusedOpens = lazy (GetString "RemoveUnusedOpens") - let UnusedOpens = lazy (GetString "UnusedOpens") - let AddProjectReference = lazy (GetString "AddProjectReference") - let AddAssemblyReference = lazy (GetString "AddAssemblyReference") - let NavigatingTo = lazy (GetString "NavigatingTo") - let CannotDetermineSymbol = lazy (GetString "CannotDetermineSymbol") - let CannotNavigateUnknown = lazy (GetString "CannotNavigateUnknown") - let LocatingSymbol = lazy (GetString "LocatingSymbol") - let NavigateToFailed = lazy (GetString "NavigateToFailed") - let ExceptionsLabel = lazy (GetString "ExceptionsHeader") - let GenericParametersLabel = lazy (GetString "GenericParametersHeader") - - //-------------------------------------------------------------------------------------- - // Attributes used to mark up editable properties - - [] - type internal SRDescriptionAttribute(description:string) = - inherit DescriptionAttribute(description) - let mutable replaced = false - - override x.Description = - if not (replaced) then - replaced <- true - x.DescriptionValue <- GetString(base.Description) - base.Description - - [] - type internal SRCategoryAttribute(category:string) = - inherit CategoryAttribute(category) - override x.GetLocalizedString(value:string) = - GetString(value) - - [] - type internal SRDisplayNameAttribute(name:string) = - inherit DisplayNameAttribute() - - override x.DisplayName = - match GetString(name) with - | null -> - Debug.Assert(false, "String resource '" + name + "' is missing") - name - | result -> result diff --git a/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj b/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj index 3c08e86fe1..f8121a8f34 100644 --- a/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj +++ b/vsintegration/src/FSharp.LanguageService.Base/FSharp.LanguageService.Base.csproj @@ -178,7 +178,7 @@ $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.ComponentModelHost.15.0.26201-alpha\lib\net46\Microsoft.VisualStudio.ComponentModelHost.dll - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True diff --git a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs index ce89e4960f..36404fd5eb 100644 --- a/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs +++ b/vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs @@ -16,6 +16,9 @@ open Microsoft.VisualStudio.Shell.Interop open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.SourceCodeServices + +#nowarn "44" // use of obsolete CheckFileInProjectAllowingStaleCachedResults + // // Note: DEPRECATED CODE ONLY ACTIVE IN UNIT TESTING VIA "UNROSLYNIZED" UNIT TESTS. // @@ -206,7 +209,12 @@ type internal FSharpLanguageServiceBackgroundRequests_DEPRECATED // Now that we have the parseResults, we can SetDependencyFiles(). // // If the set of dependencies changes, the file needs to be re-checked - let anyDependenciesChanged = source.SetDependencyFiles(parseResults.DependencyFiles) + let dependencyFiles = + match typedResults with + | None -> parseResults.DependencyFiles + | Some r -> r.DependencyFiles + + let anyDependenciesChanged = source.SetDependencyFiles(dependencyFiles) if anyDependenciesChanged then req.ResultClearsDirtinessOfFile <- false // Furthermore, if the project is out-of-date behave just as if we were notified dependency files changed. diff --git a/vsintegration/src/FSharp.LanguageService/Error.fs b/vsintegration/src/FSharp.LanguageService/Error.fs index e370dbcb42..e2a785a686 100644 --- a/vsintegration/src/FSharp.LanguageService/Error.fs +++ b/vsintegration/src/FSharp.LanguageService/Error.fs @@ -23,36 +23,8 @@ module internal Error = let UseOfUnitializedServiceProvider = invalidOperation "ServiceProvider used before complete initialization." let Bug = invalidOperation "Unexpected." -/// Localizable strings. -module internal Strings = - - let private resources = new System.Resources.ResourceManager("FSLangSvcStrings", System.Reflection.Assembly.GetExecutingAssembly()) - - /// Exceptions: - let ExceptionsHeader = resources.GetString("ExceptionsHeader", System.Globalization.CultureInfo.CurrentUICulture) - /// (still building content cache) - let StillBuildingContentCache = resources.GetString("StillBuildingContentCache", System.Globalization.CultureInfo.CurrentUICulture) - - let GetString(s) = resources.GetString(s, System.Globalization.CultureInfo.CurrentUICulture) - - module Errors = - let private Format1 id (s : string) = - let format = GetString(id) - System.String.Format(format, s) - - let GotoDefinitionFailed () = GetString "GotoDefinitionFailed_Generic" - let GotoDefinitionFailed_ProvidedType(typeName : string) = Format1 "GotoDefinitionFailed_ProvidedType" typeName - let GotoFailed_ProvidedMember(name : string) = Format1 "GotoDefinitionFailed_ProvidedMember" name - let GotoDefinitionFailed_NotIdentifier () = GetString "GotoDefinitionFailed_NotIdentifier" - let GotoDefinitionFailed_NoTypecheckInfo () = GetString "GotoDefinitionFailed_NoTypecheckInfo" - let GotoDefinitionFailed_NoSourceCode () = GetString "GotoDefinitionFailed_NotSourceCode" - /// Assert helpers type internal Assert() = /// Display a good exception for this error message and then rethrow. static member Exception(e:Exception) = System.Diagnostics.Debug.Assert(false, "Unexpected exception seen in language service", e.ToString()) - - - - diff --git a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj index 11af261860..96ed9e9404 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj +++ b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj @@ -50,7 +50,9 @@ false - + + Microsoft.VisualStudio.FSharp.LanguageService.Strings + @@ -237,7 +239,7 @@ True - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True diff --git a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs index c99ceb2ea3..079f2d9393 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharpSource.fs +++ b/vsintegration/src/FSharp.LanguageService/FSharpSource.fs @@ -66,7 +66,7 @@ type internal IFSharpSource_DEPRECATED = /// Store a ProjectSite for obtaining a task provider abstract ProjectSite : IProjectSite option with get,set /// Specify the files that should trigger a rebuild for the project behind this source - abstract SetDependencyFiles : string list -> bool + abstract SetDependencyFiles : string[] -> bool @@ -293,7 +293,7 @@ type internal FSharpIntelliSenseToAppearAdornment_DEPRECATED(view: IWpfTextView, else new SnapshotSpan(view.TextSnapshot, Span.FromBounds(i-1, i)) let g = textViewLines.GetMarkerGeometry(span) - let tb = new System.Windows.Controls.TextBlock(Text=Strings.GetString "IntelliSenseLoading", FontFamily=System.Windows.Media.FontFamily(fontFamily), FontSize=pointSize) + let tb = new System.Windows.Controls.TextBlock(Text=Strings.IntelliSenseLoading(), FontFamily=System.Windows.Media.FontFamily(fontFamily), FontSize=pointSize) tb.Foreground <- excludedCodeForegroundColorBrush let sp = new System.Windows.Controls.StackPanel(Orientation=System.Windows.Controls.Orientation.Horizontal) System.Windows.Documents.TextElement.SetForeground(sp, excludedCodeForegroundColorBrush.GetAsFrozen() :?> System.Windows.Media.Brush) @@ -356,7 +356,7 @@ type internal FSharpSource_DEPRECATED(service:LanguageService_DEPRECATED, textLi |] // get a sync parse of the file - let co = + let co, _ = { ProjectFileName = fileName + ".dummy.fsproj" SourceFiles = [| fileName |] OtherOptions = flags @@ -368,8 +368,9 @@ type internal FSharpSource_DEPRECATED(service:LanguageService_DEPRECATED, textLi OriginalLoadReferences = [] ExtraProjectInfo=None Stamp = None } + |> ic.GetParsingOptionsFromProjectOptions - ic.ParseFileInProject(fileName, source.GetText(), co) |> Async.RunSynchronously + ic.ParseFile(fileName, source.GetText(), co) |> Async.RunSynchronously override source.GetCommentFormat() = let mutable info = new CommentInfo() diff --git a/vsintegration/src/FSharp.LanguageService/GotoDefinition.fs b/vsintegration/src/FSharp.LanguageService/GotoDefinition.fs index c06350adb0..dd4f2df45b 100644 --- a/vsintegration/src/FSharp.LanguageService/GotoDefinition.fs +++ b/vsintegration/src/FSharp.LanguageService/GotoDefinition.fs @@ -65,12 +65,12 @@ module internal GotoDefinition = Some(colIdent, tag, qualId), false match identInfo with | None -> - Strings.Errors.GotoDefinitionFailed_NotIdentifier () + Strings.GotoDefinitionFailed_NotIdentifier() |> GotoDefinitionResult_DEPRECATED.MakeError | Some(colIdent, tag, qualId) -> if typedResults.HasFullTypeCheckInfo then if Parser.tokenTagToTokenId tag <> Parser.TOKEN_IDENT then - Strings.Errors.GotoDefinitionFailed_NotIdentifier () + Strings.GotoDefinitionFailed_NotIdentifier() |> GotoDefinitionResult_DEPRECATED.MakeError else match typedResults.GetDeclarationLocation (line+1, colIdent, lineStr, qualId, false) |> Async.RunSynchronously with @@ -83,16 +83,16 @@ module internal GotoDefinition = Trace.Write("LanguageService", sprintf "Goto definition failed: Reason %+A" reason) let text = match reason with - | FSharpFindDeclFailureReason.Unknown _message -> Strings.Errors.GotoDefinitionFailed() - | FSharpFindDeclFailureReason.NoSourceCode -> Strings.Errors.GotoDefinitionFailed_NoSourceCode() - | FSharpFindDeclFailureReason.ProvidedType(typeName) -> Strings.Errors.GotoDefinitionFailed_ProvidedType(typeName) - | FSharpFindDeclFailureReason.ProvidedMember(name) -> Strings.Errors.GotoFailed_ProvidedMember(name) + | FSharpFindDeclFailureReason.Unknown _message -> Strings.GotoDefinitionFailed_Generic() + | FSharpFindDeclFailureReason.NoSourceCode -> Strings.GotoDefinitionFailed_NotSourceCode() + | FSharpFindDeclFailureReason.ProvidedType(typeName) -> String.Format(Strings.GotoDefinitionFailed_ProvidedType(), typeName) + | FSharpFindDeclFailureReason.ProvidedMember(name) -> String.Format(Strings.GotoDefinitionFailed_ProvidedMember(), name) GotoDefinitionResult_DEPRECATED.MakeError text | FSharpFindDeclResult.ExternalDecl _ -> - GotoDefinitionResult_DEPRECATED.MakeError(Strings.Errors.GotoDefinitionFailed_NoSourceCode()) + GotoDefinitionResult_DEPRECATED.MakeError(Strings.GotoDefinitionFailed_NotSourceCode()) else Trace.Write("LanguageService", "Goto definition: No 'TypeCheckInfo' available") - Strings.Errors.GotoDefinitionFailed_NoTypecheckInfo() + Strings.GotoDefinitionFailed_NoTypecheckInfo() |> GotoDefinitionResult_DEPRECATED.MakeError gotoDefinition false diff --git a/vsintegration/src/FSharp.LanguageService/ProjectSitesAndFiles.fs b/vsintegration/src/FSharp.LanguageService/ProjectSitesAndFiles.fs index 6022fd1149..122d685184 100644 --- a/vsintegration/src/FSharp.LanguageService/ProjectSitesAndFiles.fs +++ b/vsintegration/src/FSharp.LanguageService/ProjectSitesAndFiles.fs @@ -234,10 +234,10 @@ type internal ProjectSitesAndFiles() = | None -> None - member art.GetDefinesForFile_DEPRECATED(rdt:IVsRunningDocumentTable, filename : string) = + member art.GetDefinesForFile_DEPRECATED(rdt:IVsRunningDocumentTable, filename : string, checker:FSharpChecker) = // The only caller of this function calls it each time it needs to colorize a line, so this call must execute very fast. if SourceFile.MustBeSingleFileProject(filename) then - CompilerEnvironment.GetCompilationDefinesForEditing(filename,[]) + CompilerEnvironment.GetCompilationDefinesForEditing(filename,FSharpParsingOptions.Default) else let siteOpt = match VsRunningDocumentTable.FindDocumentWithoutLocking(rdt,filename) with @@ -249,7 +249,8 @@ type internal ProjectSitesAndFiles() = | Some site -> site | None -> ProjectSitesAndFiles.ProjectSiteOfSingleFile(filename) - CompilerEnvironment.GetCompilationDefinesForEditing(filename,site.CompilationOptions |> Array.toList) + let parsingOptions,_ = checker.GetParsingOptionsFromCommandLineArgs( site.CompilationOptions |> Array.toList) + CompilerEnvironment.GetCompilationDefinesForEditing(filename,parsingOptions) member art.TryFindOwningProject_DEPRECATED(rdt:IVsRunningDocumentTable, filename) = diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/MSBuildUtilities.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/MSBuildUtilities.fs index 7d3fc17e32..1a639984f9 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/MSBuildUtilities.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/MSBuildUtilities.fs @@ -125,7 +125,7 @@ type internal MSBuildUtilities() = Inc(curPathParts) curPathParts.Add(pathParts.[curPathParts.Count]) // e.g. transition from A\ to A\D\E\bar.fs if not(alreadyRenderedFolders.Add(new List(curPathParts))) && throwIfCannotRender then - raise <| new InvalidOperationException(String.Format(FSharpSR.GetString(FSharpSR.ProjectRenderFolderMultiple), projectNode.ProjectFile, bi.Include)) + raise <| new InvalidOperationException(String.Format(FSharpSR.ProjectRenderFolderMultiple(), projectNode.ProjectFile, bi.Include)) Inc(curPathParts) if bi.ItemType = ProjectFileConstants.Folder then explicitFolders.Add(new List<_>(pathParts), (bi,0)) diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 56c00e8646..aeac457a16 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -524,7 +524,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem VsShellUtilities.ShowMessageBox ( serviceProvider = this.Site, - message = FSharpSR.GetString(FSharpSR.FSharpCoreVersionIsNotLegacyCompatible), + message = FSharpSR.FSharpCoreVersionIsNotLegacyCompatible(), title = null, icon = OLEMSGICON.OLEMSGICON_QUERY, msgButton = OLEMSGBUTTON.OLEMSGBUTTON_YESNO, @@ -840,7 +840,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem /// Full path to destination file override x.AddFileFromTemplate(source:string, target:string ) = if not (Microsoft.FSharp.Compiler.AbstractIL.Internal.Library.Shim.FileSystem.SafeExists(source)) then - raise <| new FileNotFoundException(String.Format(FSharpSR.GetString(FSharpSR.TemplateNotFound), source)) + raise <| new FileNotFoundException(String.Format(FSharpSR.TemplateNotFound(), source)) // We assume that there is no token inside the file because the only // way to add a new element should be through the template wizard that @@ -945,7 +945,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem /// The formatlist to return override x.GetFormatList(formatlist:byref ) = // see docs for IPersistFileFormat.GetFormatList for correct format of this string - formatlist <- sprintf "%s\n*.fsproj\n" (FSharpSR.GetString(FSharpSR.ProjectFileExtensionFilter)) + formatlist <- sprintf "%s\n*.fsproj\n" (FSharpSR.ProjectFileExtensionFilter()) VSConstants.S_OK member this.IsCurrentProjectDotNetPortable() = this.CheckProjectFrameworkIdentifier(".NETPortable") @@ -991,7 +991,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem stripEndingSemicolon paths let dialogTitle = - let text = FSharpSR.GetString(FSharpSR.AddReferenceDialogTitleDev11) + let text = FSharpSR.AddReferenceDialogTitle_Dev11() String.Format(text, self.VSProject.Project.Name) let referenceContainerNode = this.GetReferenceContainer() :?> ReferenceContainerNode @@ -1027,9 +1027,9 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem // MSDN: Gets or sets whether the assembly is referenced implicitly assemblyReferenceProviderContext.IsImplicitlyReferenced <- false // MSDN: Gets or sets the message to display during retargeting. - assemblyReferenceProviderContext.RetargetingMessage <- FSharpSR.GetString(FSharpSR.AddReferenceAssemblyPageDialogRetargetingText) + assemblyReferenceProviderContext.RetargetingMessage <- FSharpSR.AddReferenceAssemblyPageDialogRetargetingText() // MSDN: Sets the custom no items message for the specified tab. - assemblyReferenceProviderContext.SetNoItemsMessageForTab(uint32 __VSASSEMBLYPROVIDERTAB.TAB_ASSEMBLY_FRAMEWORK, FSharpSR.GetString(FSharpSR.AddReferenceAssemblyPageDialogNoItemsText)) + assemblyReferenceProviderContext.SetNoItemsMessageForTab(uint32 __VSASSEMBLYPROVIDERTAB.TAB_ASSEMBLY_FRAMEWORK, FSharpSR.AddReferenceAssemblyPageDialogNoItemsText()) // we support only fixed set of portable profiles thus retargeting is prohibited assemblyReferenceProviderContext.SupportsRetargeting <- false @@ -1084,7 +1084,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem let c = let c = componentDialog.CreateProviderContext(VSConstants.FileReferenceProvider_Guid) let fileReferenceProviderContext = c :?> IVsFileReferenceProviderContext - fileReferenceProviderContext.BrowseFilter <- sprintf "%s|*.dll;*.exe;" (FSharpSR.GetString FSharpSR.ComponentFileExtensionFilter) + fileReferenceProviderContext.BrowseFilter <- sprintf "%s|*.dll;*.exe;" (FSharpSR.ComponentFileExtensionFilter()) c yield c // TODO, eventually, win8 stuff @@ -1322,8 +1322,8 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem use sourcesAndFlagsWaitDialog = { - WaitCaption = FSharpSR.GetString FSharpSR.ProductName - WaitMessage = FSharpSR.GetString FSharpSR.ComputingSourcesAndFlags + WaitCaption = FSharpSR.ProductName() + WaitMessage = FSharpSR.ComputingSourcesAndFlags() ProgressText = Some x.ProjectFile StatusBmpAnim = null StatusBarText = None @@ -1756,8 +1756,8 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem if waitCount = 0 then waitDialog <- { - WaitCaption = FSharpSR.GetString FSharpSR.ProductName - WaitMessage = FSharpSR.GetString FSharpSR.UpdatingSolutionConfiguration + WaitCaption = FSharpSR.ProductName() + WaitMessage = FSharpSR.UpdatingSolutionConfiguration() ProgressText = None StatusBmpAnim = null StatusBarText = None @@ -1919,13 +1919,13 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem VsShellUtilities.ShowMessageBox ( node.Site, - FSharpSR.GetString(FSharpSR.Dev11SupportsOnlySilverlight5), + FSharpSR.Dev11SupportsOnlySilverlight5(), null, OLEMSGICON.OLEMSGICON_INFO, OLEMSGBUTTON.OLEMSGBUTTON_OK, OLEMSGDEFBUTTON.OLEMSGDEFBUTTON_FIRST ) |> ignore Marshal.ThrowExceptionForHR(VSConstants.OLE_E_PROMPTSAVECANCELLED) let result = - VsShellUtilities.ShowMessageBox(node.Site, FSharpSR.GetStringWithCR(FSharpSR.NeedReloadToChangeTargetFx), + VsShellUtilities.ShowMessageBox(node.Site, FSharpSR.NeedReloadToChangeTargetFx().Replace(@"\n", Environment.NewLine), null, OLEMSGICON.OLEMSGICON_QUERY, OLEMSGBUTTON.OLEMSGBUTTON_YESNO, OLEMSGDEFBUTTON.OLEMSGDEFBUTTON_FIRST) if result <> NativeMethods.IDYES then @@ -1967,7 +1967,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem | OutputType.WinExe -> "WinExe" | OutputType.Exe -> "Exe" | OutputType.Library -> "Library" - | _ -> raise <| ArgumentException(FSharpSR.GetString(FSharpSR.InvalidOutputType), "value") + | _ -> raise <| ArgumentException(FSharpSR.InvalidOutputType(), "value") this.Node.ProjectMgr.SetProjectProperty(ProjectFileConstants.OutputType, outputTypeInteger) [] @@ -2000,7 +2000,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem | 0 -> "Always" | 1 -> "OnBuildSuccess" | 2 -> "OnOutputUpdated" - | _ -> raise <| ArgumentException(FSharpSR.GetString(FSharpSR.InvalidRunPostBuildEvent), "value") + | _ -> raise <| ArgumentException(FSharpSR.InvalidRunPostBuildEvent(), "value") this.Node.ProjectMgr.SetProjectProperty(ProjectFileConstants.RunPostBuildEvent, runPostBuildEventInteger) type internal FSharpFolderNode(root : FSharpProjectNode, relativePath : string, projectElement : ProjectElement) = @@ -2412,11 +2412,11 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem if fileChildren = [nodeToBeMoved] then Ok siblingNode else - Error <| String.Format(FSharpSR.GetString(FSharpSR.FileCannotBePlacedMultipleFiles), siblingNode.VirtualNodeName) + Error <| String.Format(FSharpSR.FileCannotBePlacedMultipleFiles(), siblingNode.VirtualNodeName) | Some siblingNode -> Ok siblingNode | None -> - Error <| FSharpSR.GetString(FSharpSR.FileCannotBePlacedDifferentSubtree) + Error <| FSharpSR.FileCannotBePlacedDifferentSubtree() |> function | Ok node -> unlinkFromSiblings node @@ -2451,9 +2451,9 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem let bodyString = match location with - | Above -> FSharpSR.FileCannotBePlacedBodyAbove - | Below -> FSharpSR.FileCannotBePlacedBodyBelow - |> FSharpSR.GetStringWithCR + | Above -> FSharpSR.FileCannotBePlacedBodyAbove() + | Below -> FSharpSR.FileCannotBePlacedBodyBelow() + |> (fun s -> s.Replace(@"\n", Environment.NewLine)) let entireMessage = String.Format(bodyString, relPath, relTargetPath, message) VsShellUtilities.ShowMessageBox(root.Site, title, entireMessage, icon, buttons, defaultButton) |> ignore diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs index ce8d742998..fdc9282c05 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectPrelude.fs @@ -121,134 +121,6 @@ namespace Microsoft.VisualStudio.FSharp.ProjectSystem open Helpers - //-------------------------------------------------------------------------------------- - // The Resource Reader - - module internal FSharpSR = - [] - let ProjectReferenceError2 = "ProjectReferenceError2" - [] - let Application = "Application" - [] - let ApplicationIcon = "ApplicationIcon" - [] - let ApplicationIconDescription = "ApplicationIconDescription" - [] - let AssemblyName = "AssemblyName" - [] - let AssemblyNameDescription = "AssemblyNameDescription" - [] - let DefaultNamespace = "DefaultNamespace" - [] - let DefaultNamespaceDescription = "DefaultNamespaceDescription" - [] - let GeneralCaption = "GeneralCaption" - [] - let InvalidOutputType = "InvalidOutputType" - [] - let InvalidRunPostBuildEvent = "InvalidRunPostBuildEvent" - [] - let InvalidTargetFrameworkVersion = "InvalidTargetFrameworkVersion" - [] - let OutputFile = "OutputFile" - [] - let OutputFileDescription = "OutputFileDescription" - [] - let OutputType = "OutputType" - [] - let OutputTypeDescription = "OutputTypeDescription" - [] - let ProductName = "ProductName" - [] - let Project = "Project" - [] - let ProjectFile = "ProjectFile" - [] - let ProjectFileDescription = "ProjectFileDescription" - [] - let ProjectFileExtensionFilter = "ProjectFileExtensionFilter" - [] - let ComponentFileExtensionFilter = "ComponentFileExtensionFilter" - [] - let ProjectFolder = "ProjectFolder" - [] - let ProjectRenderFolderMultiple = "ProjectRenderFolderMultiple" - [] - let ProjectFolderDescription = "ProjectFolderDescription" - [] - let PropertyDefaultNamespace = "PropertyDefaultNamespace" - [] - let StartupObject = "StartupObject" - [] - let StartupObjectDescription = "StartupObjectDescription" - [] - let TargetPlatform = "TargetPlatform" - [] - let TargetPlatformDescription = "TargetPlatformDescription" - [] - let TargetPlatformLocation = "TargetPlatformLocation" - [] - let TargetPlatformLocationDescription = "TargetPlatformLocationDescription" - [] - let OtherFlags = "OtherFlags" - [] - let OtherFlagsDescription = "OtherFlagsDescription" - [] - let Tailcalls = "Tailcalls" - [] - let TailcallsDescription = "TailcallsDescription" - [] - let UseStandardResourceNames = "UseStandardResourceNames" - [] - let UseStandardResourceNamesDescription = "UseStandardResourceNamesDescription" - [] - let TemplateNotFound = "TemplateNotFound" - [] - let NeedReloadToChangeTargetFx = "NeedReloadToChangeTargetFx" - [] - let NeedReloadToChangeTargetFxCaption = "NeedReloadToChangeTargetFxCaption" - [] - let Build = "Build" - [] - let AddReferenceDialogTitle = "AddReferenceDialogTitle"; - [] - let AddReferenceDialogTitleDev11 = "AddReferenceDialogTitle_Dev11"; - [] - let Dev11SupportsOnlySilverlight5 = "Dev11SupportsOnlySilverlight5"; - [] - let AddReferenceAssemblyPageDialogRetargetingText = "AddReferenceAssemblyPageDialogRetargetingText"; - [] - let AddReferenceAssemblyPageDialogNoItemsText = "AddReferenceAssemblyPageDialogNoItemsText"; - [] - let FSharpCoreVersionIsNotLegacyCompatible = "FSharpCoreVersionIsNotLegacyCompatible"; - [] - let ComputingSourcesAndFlags = "ComputingSourcesAndFlags" - [] - let UpdatingSolutionConfiguration = "UpdatingSolutionConfiguration" - [] - let FileCannotBePlacedBodyAbove = "FileCannotBePlacedBodyAbove" - [] - let FileCannotBePlacedBodyBelow = "FileCannotBePlacedBodyBelow" - [] - let FileCannotBePlacedDifferentSubtree = "FileCannotBePlacedDifferentSubtree" - [] - let FileCannotBePlacedMultipleFiles = "FileCannotBePlacedMultipleFiles" - - type private TypeInThisAssembly = class end - let thisAssembly = typeof.Assembly - - let private resources = lazy (new System.Resources.ResourceManager("VSPackage", thisAssembly)) - - let GetString(name:string) = - resources.Force().GetString(name, CultureInfo.CurrentUICulture) - - let GetStringWithCR(name:string) = - let s = resources.Force().GetString(name, CultureInfo.CurrentUICulture) - s.Replace(@"\n", Environment.NewLine) - - let GetObject(name:string) = - resources.Force().GetObject(name, CultureInfo.CurrentUICulture) - //-------------------------------------------------------------------------------------- // Attributes used to mark up editable properties diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj index e5f34c87d5..077dbc4d30 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj @@ -79,7 +79,8 @@ 210 - + + Microsoft.VisualStudio.FSharp.ProjectSystem.FSharpSR true @@ -210,10 +211,8 @@ $(FSharpSourcesRoot)\..\packages\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).$(RoslynVSPackagesVersion)\lib\Microsoft.VisualStudio.Shell.$(RoslynVSBinariesVersion).dll - - - - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3} diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/VSPackage.resx b/vsintegration/src/FSharp.ProjectSystem.FSharp/VSPackage.resx index f66f0049a8..5bb05a0bfe 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/VSPackage.resx +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/VSPackage.resx @@ -221,7 +221,7 @@ Resources\FSharpAboutBox.ico;System.Drawing.Icon, System.Drawing, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a - + ctofiles\MenusAndCommands.cto;System.Byte[], mscorlib, Version=1.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a diff --git a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj index 4cf690ac79..080745543a 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj @@ -48,7 +48,7 @@ - + CompilerLocationUtils.fs @@ -60,7 +60,9 @@ - + + Microsoft.VisualStudio.FSharp.Interactive.SRProperties + true Properties Properties.resx diff --git a/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.Attributes.fs b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.Attributes.fs new file mode 100644 index 0000000000..78442f823b --- /dev/null +++ b/vsintegration/src/FSharp.VS.FSI/FSharp.VS.FSI.Attributes.fs @@ -0,0 +1,12 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Interactive + +type internal ResourceDisplayNameAttribute(resName) = + inherit System.ComponentModel.DisplayNameAttribute(SRProperties.GetString(resName)) + +type internal ResourceDescriptionAttribute(resName) = + inherit System.ComponentModel.DescriptionAttribute(SRProperties.GetString(resName)) + +type internal ResourceCategoryAttribute(resName) = + inherit System.ComponentModel.CategoryAttribute(SRProperties.GetString(resName)) diff --git a/vsintegration/src/FSharp.VS.FSI/fsiLanguageService.fs b/vsintegration/src/FSharp.VS.FSI/fsiLanguageService.fs index 5924a202ee..62d2cf7efe 100644 --- a/vsintegration/src/FSharp.VS.FSI/fsiLanguageService.fs +++ b/vsintegration/src/FSharp.VS.FSI/fsiLanguageService.fs @@ -11,6 +11,7 @@ open System.Runtime.InteropServices open System.ComponentModel.Design open Microsoft.Win32 open Microsoft.VisualStudio +open Microsoft.VisualStudio.FSharp.Interactive open Microsoft.VisualStudio.OLE.Interop open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.Shell.Interop @@ -37,24 +38,24 @@ module internal ContentType = type FsiPropertyPage() = inherit DialogPage() - [] - [] - [] + [] + [] + [] member this.FsiPreferAnyCPUVersion with get() = SessionsProperties.useAnyCpuVersion and set (x:bool) = SessionsProperties.useAnyCpuVersion <- x - [] - [] - [] + [] + [] + [] member this.FsiCommandLineArgs with get() = SessionsProperties.fsiArgs and set (x:string) = SessionsProperties.fsiArgs <- x - [] - [] - [] + [] + [] + [] member this.FsiShadowCopy with get() = SessionsProperties.fsiShadowCopy and set (x:bool) = SessionsProperties.fsiShadowCopy <- x - [] - [] - [] + [] + [] + [] member this.FsiDebugMode with get() = SessionsProperties.fsiDebugMode and set (x:bool) = SessionsProperties.fsiDebugMode <- x // CompletionSet diff --git a/vsintegration/src/FSharp.VS.FSI/srProperties.fs b/vsintegration/src/FSharp.VS.FSI/srProperties.fs deleted file mode 100644 index e88071d35b..0000000000 --- a/vsintegration/src/FSharp.VS.FSI/srProperties.fs +++ /dev/null @@ -1,52 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal Microsoft.VisualStudio.FSharp.Interactive.SRProperties - -let private resources = lazy (new System.Resources.ResourceManager("Properties", System.Reflection.Assembly.GetExecutingAssembly())) - -let GetString(name:string) = - let s = resources.Value.GetString(name, System.Globalization.CultureInfo.CurrentUICulture) -#if DEBUG - if null = s then - System.Diagnostics.Debug.Assert(false, sprintf "**RESOURCE ERROR**: Resource token %s does not exist!" name) -#endif - s.Replace(@"\n", System.Environment.NewLine) - -[] -let FSharpInteractive64Bit = "FSharpInteractive64Bit" - -[] -let FSharpInteractive64BitDescr = "FSharpInteractive64BitDescr" - -[] -let FSharpInteractiveOptions = "FSharpInteractiveOptions" - -[] -let FSharpInteractiveOptionsDescr = "FSharpInteractiveOptionsDescr" - -[] -let FSharpInteractiveShadowCopyDescr = "FSharpInteractiveShadowCopyDescr" - -[] -let FSharpInteractiveShadowCopy = "FSharpInteractiveShadowCopy" - -[] -let FSharpInteractiveDebugMode = "FSharpInteractiveDebugMode" - -[] -let FSharpInteractiveDebugModeDescr = "FSharpInteractiveDebugModeDescr" - -[] -let FSharpInteractiveMisc = "FSharpInteractiveMisc" - -[] -let FSharpInteractiveDebugging = "FSharpInteractiveDebugging" - -type DisplayNameAttribute(resName) = - inherit System.ComponentModel.DisplayNameAttribute(GetString(resName)) - -type DescriptionAttribute(resName) = - inherit System.ComponentModel.DescriptionAttribute(GetString(resName)) - -type CategoryAttribute(resName) = - inherit System.ComponentModel.CategoryAttribute(GetString(resName)) \ No newline at end of file diff --git a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs index f0812f1d56..7a2976e093 100644 --- a/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs +++ b/vsintegration/tests/Salsa/FSharpLanguageServiceTestable.fs @@ -210,7 +210,7 @@ type internal FSharpLanguageServiceTestable() as this = // So this is not ideal from a perf perspective, but it is easy to reason about the correctness. let filename = VsTextLines.GetFilename buffer let rdt = this.ServiceProvider.RunningDocumentTable - let defines = this.ProjectSitesAndFiles.GetDefinesForFile_DEPRECATED(rdt, filename) + let defines = this.ProjectSitesAndFiles.GetDefinesForFile_DEPRECATED(rdt, filename, this.FSharpChecker) let sourceTokenizer = FSharpSourceTokenizer(defines,Some(filename)) sourceTokenizer.CreateLineTokenizer(source)) diff --git a/vsintegration/tests/unittests/BraceMatchingServiceTests.fs b/vsintegration/tests/unittests/BraceMatchingServiceTests.fs index 277ad012f4..8e3d4ee7c9 100644 --- a/vsintegration/tests/unittests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/unittests/BraceMatchingServiceTests.fs @@ -17,7 +17,7 @@ open UnitTests.TestLib.LanguageService [][] type BraceMatchingServiceTests() = let fileName = "C:\\test.fs" - let options: FSharpProjectOptions = { + let projectOptions: FSharpProjectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| fileName |] ReferencedProjects = [| |] @@ -36,7 +36,8 @@ type BraceMatchingServiceTests() = let position = fileContents.IndexOf(marker) Assert.IsTrue(position >= 0, "Cannot find marker '{0}' in file contents", marker) - match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, options, position, "UnitTest") |> Async.RunSynchronously with + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, position, "UnitTest") |> Async.RunSynchronously with | None -> () | Some(left, right) -> Assert.Fail("Found match for brace '{0}'", marker) @@ -48,7 +49,8 @@ type BraceMatchingServiceTests() = Assert.IsTrue(startMarkerPosition >= 0, "Cannot find start marker '{0}' in file contents", startMarkerPosition) Assert.IsTrue(endMarkerPosition >= 0, "Cannot find end marker '{0}' in file contents", endMarkerPosition) - match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, options, startMarkerPosition, "UnitTest") |> Async.RunSynchronously with + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, startMarkerPosition, "UnitTest") |> Async.RunSynchronously with | None -> Assert.Fail("Didn't find a match for start brace at position '{0}", startMarkerPosition) | Some(left, right) -> let endPositionInRange(range) = @@ -169,9 +171,10 @@ let main argv = // https://github.com/Microsoft/visualfsharp/issues/2092 let sourceText = SourceText.From(fileContents) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions matchingPositions |> Array.iter (fun position -> - match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, options, position, "UnitTest") |> Async.RunSynchronously with + match FSharpBraceMatchingService.GetBraceMatchingResult(checker, sourceText, fileName, parsingOptions, position, "UnitTest") |> Async.RunSynchronously with | Some _ -> () | None -> match position with diff --git a/vsintegration/tests/unittests/BreakpointResolutionService.fs b/vsintegration/tests/unittests/BreakpointResolutionService.fs index 3461d3009b..c84c1b76f7 100644 --- a/vsintegration/tests/unittests/BreakpointResolutionService.fs +++ b/vsintegration/tests/unittests/BreakpointResolutionService.fs @@ -22,7 +22,7 @@ open UnitTests.TestLib.LanguageService type BreakpointResolutionServiceTests() = let fileName = "C:\\test.fs" - let options: FSharpProjectOptions = { + let projectOptions: FSharpProjectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| fileName |] ReferencedProjects = [| |] @@ -74,7 +74,8 @@ let main argv = let sourceText = SourceText.From(code) let searchSpan = TextSpan.FromBounds(searchPosition, searchPosition + searchToken.Length) - let actualResolutionOption = FSharpBreakpointResolutionService.GetBreakpointLocation(checker, sourceText, fileName, searchSpan, options) |> Async.RunSynchronously + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + let actualResolutionOption = FSharpBreakpointResolutionService.GetBreakpointLocation(checker, sourceText, fileName, searchSpan, parsingOptions) |> Async.RunSynchronously match actualResolutionOption with | None -> Assert.IsTrue(expectedResolution.IsNone, "BreakpointResolutionService failed to resolve breakpoint position") diff --git a/vsintegration/tests/unittests/CompletionProviderTests.fs b/vsintegration/tests/unittests/CompletionProviderTests.fs index a0de868fc7..e34ed22f0e 100644 --- a/vsintegration/tests/unittests/CompletionProviderTests.fs +++ b/vsintegration/tests/unittests/CompletionProviderTests.fs @@ -35,7 +35,7 @@ open Microsoft.FSharp.Compiler.SourceCodeServices open UnitTests.TestLib.LanguageService let filePath = "C:\\test.fs" -let internal options = { +let internal projectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -52,7 +52,7 @@ let internal options = { let VerifyCompletionList(fileContents: string, marker: string, expected: string list, unexpected: string list) = let caretPosition = fileContents.IndexOf(marker) + marker.Length let results = - FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, options, filePath, 0, fun _ -> []) + FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions, filePath, 0, fun _ -> []) |> Async.RunSynchronously |> Option.defaultValue (ResizeArray()) |> Seq.map(fun result -> result.DisplayText) @@ -67,7 +67,7 @@ let VerifyCompletionListExactly(fileContents: string, marker: string, expected: let caretPosition = fileContents.IndexOf(marker) + marker.Length let actual = - FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, options, filePath, 0, fun _ -> []) + FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions, filePath, 0, fun _ -> []) |> Async.RunSynchronously |> Option.defaultValue (ResizeArray()) |> Seq.toList diff --git a/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs index 912738d538..d7302afc29 100644 --- a/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/unittests/DocumentDiagnosticAnalyzerTests.fs @@ -24,7 +24,7 @@ type DocumentDiagnosticAnalyzerTests() = let filePath = "C:\\test.fs" let startMarker = "(*start*)" let endMarker = "(*end*)" - let options: FSharpProjectOptions = { + let projectOptions: FSharpProjectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -40,15 +40,17 @@ type DocumentDiagnosticAnalyzerTests() = let getDiagnostics (fileContents: string) = async { - let! syntacticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(checker, filePath, SourceText.From(fileContents), 0, options, DiagnosticsType.Syntax) - let! semanticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(checker, filePath, SourceText.From(fileContents), 0, options, DiagnosticsType.Semantic) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + let! syntacticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(checker, filePath, SourceText.From(fileContents), 0, parsingOptions, projectOptions, DiagnosticsType.Syntax) + let! semanticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(checker, filePath, SourceText.From(fileContents), 0, parsingOptions, projectOptions, DiagnosticsType.Semantic) return syntacticDiagnostics.AddRange(semanticDiagnostics) } |> Async.RunSynchronously member private this.VerifyNoErrors(fileContents: string, ?additionalFlags: string[]) = + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions let additionalOptions = match additionalFlags with - | None -> options - | Some(flags) -> {options with OtherOptions = Array.append options.OtherOptions flags} + | None -> projectOptions + | Some(flags) -> {projectOptions with OtherOptions = Array.append projectOptions.OtherOptions flags} let errors = getDiagnostics fileContents Assert.AreEqual(0, errors.Length, "There should be no errors generated") diff --git a/vsintegration/tests/unittests/DocumentHighlightsServiceTests.fs b/vsintegration/tests/unittests/DocumentHighlightsServiceTests.fs index 8b884c5f61..53ac885768 100644 --- a/vsintegration/tests/unittests/DocumentHighlightsServiceTests.fs +++ b/vsintegration/tests/unittests/DocumentHighlightsServiceTests.fs @@ -37,7 +37,7 @@ open UnitTests.TestLib.LanguageService let filePath = "C:\\test.fs" -let internal options = { +let internal projectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -53,7 +53,7 @@ let internal options = { let private getSpans (sourceText: SourceText) (caretPosition: int) = let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) - FSharpDocumentHighlightsService.GetDocumentHighlights(checker, documentId, sourceText, filePath, caretPosition, [], options, 0) + FSharpDocumentHighlightsService.GetDocumentHighlights(checker, documentId, sourceText, filePath, caretPosition, [], projectOptions, 0) |> Async.RunSynchronously |> Option.defaultValue [||] diff --git a/vsintegration/tests/unittests/EditorFormattingServiceTests.fs b/vsintegration/tests/unittests/EditorFormattingServiceTests.fs index 83cd4c381f..7fa10f056c 100644 --- a/vsintegration/tests/unittests/EditorFormattingServiceTests.fs +++ b/vsintegration/tests/unittests/EditorFormattingServiceTests.fs @@ -17,8 +17,8 @@ open Microsoft.CodeAnalysis.Formatting [] [] type EditorFormattingServiceTests() = - static let filePath = "C:\\test.fs" - static let options: FSharpProjectOptions = { + let filePath = "C:\\test.fs" + let projectOptions : FSharpProjectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -31,11 +31,12 @@ type EditorFormattingServiceTests() = ExtraProjectInfo = None Stamp = None } + //let parsingOptions: FSharpParsingOptions = - static let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) - static let indentStyle = FormattingOptions.IndentStyle.Smart + let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let indentStyle = FormattingOptions.IndentStyle.Smart - static let template = """ + let template = """ let foo = [ 15 ]marker1 @@ -66,8 +67,9 @@ let def = let sourceText = SourceText.From(template) let lineNumber = sourceText.Lines |> Seq.findIndex (fun line -> line.Span.Contains position) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions - let changesOpt = FSharpEditorFormattingService.GetFormattingChanges(documentId, sourceText, filePath, checker, indentStyle, Some options, position) |> Async.RunSynchronously + let changesOpt = FSharpEditorFormattingService.GetFormattingChanges(documentId, sourceText, filePath, checker, indentStyle, Some (parsingOptions, projectOptions), position) |> Async.RunSynchronously match changesOpt with | None -> Assert.Fail("Expected a text change, but got None") | Some change -> diff --git a/vsintegration/tests/unittests/IndentationServiceTests.fs b/vsintegration/tests/unittests/IndentationServiceTests.fs index 9534fa9911..66f92ea534 100644 --- a/vsintegration/tests/unittests/IndentationServiceTests.fs +++ b/vsintegration/tests/unittests/IndentationServiceTests.fs @@ -14,10 +14,12 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.CodeAnalysis.Formatting +open UnitTests.TestLib.LanguageService + [][] type IndentationServiceTests() = - static let filePath = "C:\\test.fs" - static let options: FSharpProjectOptions = { + let filePath = "C:\\test.fs" + let projectOptions: FSharpProjectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -31,13 +33,13 @@ type IndentationServiceTests() = Stamp = None } - static let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) - static let tabSize = 4 - static let indentStyle = FormattingOptions.IndentStyle.Smart + let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let tabSize = 4 + let indentStyle = FormattingOptions.IndentStyle.Smart - static let indentComment = System.Text.RegularExpressions.Regex(@"\$\s*Indent:\s*(\d+)\s*\$") + let indentComment = System.Text.RegularExpressions.Regex(@"\$\s*Indent:\s*(\d+)\s*\$") - static let consoleProjectTemplate = " + let consoleProjectTemplate = " // Learn more about F# at http://fsharp.org // See the 'F# Tutorial' project for more help. @@ -46,20 +48,20 @@ let main argv = printfn \"%A\" argv 0 // return an integer exit code" - static let libraryProjectTemplate = " + let libraryProjectTemplate = " namespace ProjectNamespace type Class1() = member this.X = \"F#\"" - static let nestedTypesTemplate = " + let nestedTypesTemplate = " namespace testspace type testtype static member testmember = 1 " - static let autoIndentTemplate = " + let autoIndentTemplate = " let plus x y = x + y // $Indent: 4$ @@ -130,33 +132,33 @@ while true do // The follwing line should inherit that indentation too $Indent: 4$ " - static member private testCases: Object[][] = [| - [| None; 0; consoleProjectTemplate |] - [| None; 1; consoleProjectTemplate |] - [| Some(0); 2; consoleProjectTemplate |] - [| Some(0); 3; consoleProjectTemplate |] - [| Some(0); 4; consoleProjectTemplate |] - [| Some(0); 5; consoleProjectTemplate |] - [| Some(4); 6; consoleProjectTemplate |] - [| Some(4); 7; consoleProjectTemplate |] - [| Some(4); 8; consoleProjectTemplate |] + let testCases = [| + ( None, 0, consoleProjectTemplate ) + ( None, 1, consoleProjectTemplate ) + ( Some(0), 2, consoleProjectTemplate ) + ( Some(0), 3, consoleProjectTemplate ) + ( Some(0), 4, consoleProjectTemplate ) + ( Some(0), 5, consoleProjectTemplate ) + ( Some(4), 6, consoleProjectTemplate ) + ( Some(4), 7, consoleProjectTemplate ) + ( Some(4), 8, consoleProjectTemplate ) - [| None; 0; libraryProjectTemplate |] - [| None; 1; libraryProjectTemplate |] - [| Some(0); 2; libraryProjectTemplate |] - [| Some(0); 3; libraryProjectTemplate |] - [| Some(4); 4; libraryProjectTemplate |] - [| Some(4); 5; libraryProjectTemplate |] + ( None, 0, libraryProjectTemplate ) + ( None, 1, libraryProjectTemplate ) + ( Some(0), 2, libraryProjectTemplate ) + ( Some(0), 3, libraryProjectTemplate ) + ( Some(4), 4, libraryProjectTemplate ) + ( Some(4), 5, libraryProjectTemplate ) - [| None; 0; nestedTypesTemplate |] - [| None; 1; nestedTypesTemplate |] - [| Some(0); 2; nestedTypesTemplate |] - [| Some(4); 3; nestedTypesTemplate |] - [| Some(8); 4; nestedTypesTemplate |] - [| Some(8); 5; nestedTypesTemplate |] + ( None, 0, nestedTypesTemplate ) + ( None, 1, nestedTypesTemplate ) + ( Some(0), 2, nestedTypesTemplate ) + ( Some(4), 3, nestedTypesTemplate ) + ( Some(8), 4, nestedTypesTemplate ) + ( Some(8), 5, nestedTypesTemplate ) |] - static member private autoIndentTestCases = + let autoIndentTestCases = autoIndentTemplate.Split [|'\n'|] |> Array.map (fun s -> s.Trim()) |> Array.indexed @@ -165,22 +167,26 @@ while true do if m.Success then Some (line, System.Convert.ToInt32 m.Groups.[1].Value) else None ) |> Array.map (fun (lineNumber, expectedIndentation) -> - [| Some(expectedIndentation); lineNumber; autoIndentTemplate |]: Object[] ) + ( Some(expectedIndentation), lineNumber, autoIndentTemplate )) - [] - member this.TestIndentation(expectedIndentation: Option, lineNumber: int, template: string) = - let sourceText = SourceText.From(template) + member this.TestIndentation() = + for (expectedIndentation, lineNumber, template) in testCases do + let sourceText = SourceText.From(template) - let actualIndentation = FSharpIndentationService.GetDesiredIndentation(documentId, sourceText, filePath, lineNumber, tabSize, indentStyle, Some options) - match expectedIndentation with - | None -> Assert.IsTrue(actualIndentation.IsNone, "No indentation was expected at line {0}", lineNumber) - | Some indentation -> Assert.AreEqual(expectedIndentation.Value, actualIndentation.Value, "Indentation on line {0} doesn't match", lineNumber) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + let actualIndentation = FSharpIndentationService.GetDesiredIndentation(documentId, sourceText, filePath, lineNumber, tabSize, indentStyle, Some (parsingOptions, projectOptions)) + match expectedIndentation with + | None -> Assert.IsTrue(actualIndentation.IsNone, "No indentation was expected at line {0}", lineNumber) + | Some indentation -> Assert.AreEqual(expectedIndentation.Value, actualIndentation.Value, "Indentation on line {0} doesn't match", lineNumber) - [] - member this.TestAutoIndentation(expectedIndentation: Option, lineNumber: int, template: string) = - let sourceText = SourceText.From(template) + member this.TestAutoIndentation() = + for (expectedIndentation, lineNumber, template) in autoIndentTestCases do + + + let sourceText = SourceText.From(template) - let actualIndentation = FSharpIndentationService.GetDesiredIndentation(documentId, sourceText, filePath, lineNumber, tabSize, indentStyle, Some options) - match expectedIndentation with - | None -> Assert.IsTrue(actualIndentation.IsNone, "No indentation was expected at line {0}", lineNumber) - | Some indentation -> Assert.AreEqual(expectedIndentation.Value, actualIndentation.Value, "Indentation on line {0} doesn't match", lineNumber) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions + let actualIndentation = FSharpIndentationService.GetDesiredIndentation(documentId, sourceText, filePath, lineNumber, tabSize, indentStyle, Some (parsingOptions, projectOptions)) + match expectedIndentation with + | None -> Assert.IsTrue(actualIndentation.IsNone, "No indentation was expected at line {0}", lineNumber) + | Some indentation -> Assert.AreEqual(expectedIndentation.Value, actualIndentation.Value, "Indentation on line {0} doesn't match", lineNumber) diff --git a/vsintegration/tests/unittests/QuickInfoProviderTests.fs b/vsintegration/tests/unittests/QuickInfoProviderTests.fs index 13500ea5c8..45d3945956 100644 --- a/vsintegration/tests/unittests/QuickInfoProviderTests.fs +++ b/vsintegration/tests/unittests/QuickInfoProviderTests.fs @@ -34,7 +34,7 @@ open UnitTests.TestLib.LanguageService let filePath = "C:\\test.fs" -let internal options = { +let internal projectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -97,8 +97,9 @@ Full name: System.Console" let caretPosition = fileContents.IndexOf(symbol) let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions let quickInfo = - FSharpQuickInfoProvider.ProvideQuickInfo(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, options, 0) + FSharpQuickInfoProvider.ProvideQuickInfo(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, parsingOptions, projectOptions, 0) |> Async.RunSynchronously let actual = quickInfo |> Option.map (fun (text, _, _, _) -> getQuickInfoText text) @@ -227,8 +228,9 @@ let res8 = abs 5.0 let caretPosition = fileContents.IndexOf(symbol) + symbol.Length - 1 let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions projectOptions let quickInfo = - FSharpQuickInfoProvider.ProvideQuickInfo(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, options, 0) + FSharpQuickInfoProvider.ProvideQuickInfo(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, parsingOptions, projectOptions, 0) |> Async.RunSynchronously let actual = quickInfo |> Option.map (fun (text, _, _, _) -> getQuickInfoText text) diff --git a/vsintegration/tests/unittests/SignatureHelpProviderTests.fs b/vsintegration/tests/unittests/SignatureHelpProviderTests.fs index 1d1da4e85a..2280116b4f 100644 --- a/vsintegration/tests/unittests/SignatureHelpProviderTests.fs +++ b/vsintegration/tests/unittests/SignatureHelpProviderTests.fs @@ -34,7 +34,7 @@ let filePath = "C:\\test.fs" let PathRelativeToTestAssembly p = Path.Combine(Path.GetDirectoryName(Uri( System.Reflection.Assembly.GetExecutingAssembly().CodeBase).LocalPath), p) -let internal options = { +let internal projectOptions = { ProjectFileName = "C:\\test.fsproj" SourceFiles = [| filePath |] ReferencedProjects = [| |] @@ -145,7 +145,7 @@ type foo5 = N1.T } let triggerChar = if marker = "," then Some ',' elif marker = "(" then Some '(' elif marker = "<" then Some '<' else None - let triggered = FSharpSignatureHelpProvider.ProvideMethodsAsyncAux(checker, documentationProvider, SourceText.From(fileContents), caretPosition, options, triggerChar, filePath, 0) |> Async.RunSynchronously + let triggered = FSharpSignatureHelpProvider.ProvideMethodsAsyncAux(checker, documentationProvider, SourceText.From(fileContents), caretPosition, projectOptions, triggerChar, filePath, 0) |> Async.RunSynchronously checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() let actual = match triggered with diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index d8e60903ae..aca191434a 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -4337,7 +4337,8 @@ let x = query { for bbbb in abbbbc(*D0*) do let completions = AutoCompleteAtCursor(file) Assert.AreNotEqual(0, completions.Length, "Expected some items in the list after updating platform.") - /// FEATURE: The filename on disk and the filename in the project can differ in case. +(* +/// FEATURE: The filename on disk and the filename in the project can differ in case. [] member this.``Filenames.MayBeDifferentlyCased``() = use _guard = this.UsingNewVS() @@ -4357,7 +4358,8 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AddAssemblyReference(project,"System.Deployment") let completions = AutoCompleteAtCursor(file) Assert.AreNotEqual(0, completions.Length, "Expected some items in the list after adding a reference.") - +*) + /// In this bug, a bogus flag caused the rest of flag parsing to be ignored. [] member public this.``FlagsAndSettings.Bug1969``() = diff --git a/vsintegration/tests/unittests/VisualFSharp.Unittests.dll.config b/vsintegration/tests/unittests/VisualFSharp.Unittests.dll.config index e4a42b8fd0..7f55b7d12f 100644 --- a/vsintegration/tests/unittests/VisualFSharp.Unittests.dll.config +++ b/vsintegration/tests/unittests/VisualFSharp.Unittests.dll.config @@ -47,10 +47,9 @@ - - + diff --git a/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj b/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj index 007ec01e1c..5603dd8058 100644 --- a/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj +++ b/vsintegration/tests/unittests/VisualFSharp.Unittests.fsproj @@ -336,7 +336,7 @@ True - $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.1.2.0\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll + $(FSharpSourcesRoot)\..\packages\System.Collections.Immutable.$(SystemCollectionsImmutableVersion)\lib\portable-net45+win8+wp8+wpa81\System.Collections.Immutable.dll True diff --git a/vsintegration/update-vsintegration.cmd b/vsintegration/update-vsintegration.cmd index b8f8922198..9dcb36f92d 100644 --- a/vsintegration/update-vsintegration.cmd +++ b/vsintegration/update-vsintegration.cmd @@ -3,36 +3,155 @@ @rem See License.txt in the project root for license information. @rem =========================================================================================================== -rem @echo off -setlocal +@rem Notes/instructions for modifications: +@rem +@rem * Do not use "::" for comments, as the line will be parsed and can create spurious +@rem errors, i.e. if it contains variables, "|" or ">" characters, esp. within "IF" +@rem and "FOR" compound statements +@rem +@rem * The coloring method uses the colors from color /h through a hacky trick with findstr. +@rem Only use filename-safe characters if you use CALL :colorEcho +@rem +@rem * Parts of this batch file require administrator permission. If such permissions aren't +@rem available, a warning will be issued and relevant parts will not be executed. +@rem +@rem * Currently, only one paramter is parsed and combinations are not possible +@rem +@rem * Installation of F# FSC compiler and FSI are done in the SHARED SDK directory. Henceforth +@rem each installation of Visual Studio 2017 will use the updated FSC.exe and the commandline +@rem FSI.exe. The in-product VS FSI plugin, syntax highlighting and IntelliSense must be +@rem installed through VSIXInstaller.exe debug\net40\bin\VisualFSharpOpenSource.vsix +@rem +@rem This procedure needs to be changed once F# supports multiple side-by-side installations +@rem at which point everything will go through VSIXInstaller.exe -if /i "%1" == "debug" goto :ok -if /i "%1" == "release" goto :ok +@echo off +setlocal EnableDelayedExpansion -echo Clobbers existing Visual Studio installation of F# bits -echo Usage: -echo update-vsintegration.cmd debug -echo update-vsintegration.cmd release -exit /b 1 +rem Count errors, warnings and succesful copies +set ERRORCOUNT=0 +set WARNCOUNT=0 +set COPYCOUNT=0 + +rem Enable colors, but can ONLY BE USED WITH PRINTING LINES THAT FIT IN A FILENAME! +for /F "tokens=1,2 delims=#" %%a in ('"prompt #$H#$E# & echo on & for %%b in (1) do rem"') do ( + set "DEL=%%a" +) + +if /i "%1" == "debug" ( + set ACTION=debug + set DEPLOY=yes + set BINDIR=%~dp0..\%1\net40\bin + goto :ok +) +if /i "%1" == "release" ( + set ACTION=release + set DEPLOY=yes + set BINDIR=%~dp0..\%1\net40\bin + goto :ok +) +if /i "%1" == "restore" ( + set ACTION=restore + set DEPLOY=no + set BINDIR=%~dp0..\%1 + goto :ok +) +if /i "%1" == "backup" ( + set ACTION=backup + set DEPLOY=no + set BINDIR=%~dp0..\restore + goto :ok +) + +set GOTOHELP=yes :ok -set BINDIR=%~dp0..\%1\net40\bin +set RESTOREDIR=%~dp0..\restore set TOPDIR=%~dp0.. +rem By using a token that does not exist in paths, this will resolve any ".." and "." in the path, even if path contains spaces +FOR /F "tokens=*" %%I IN ("%RESTOREDIR%") DO set RESTOREDIR=%%~fI +FOR /F "tokens=*" %%I IN ("%BINDIR%") DO set BINDIR=%%~fI +FOR /F "tokens=*" %%I IN ("%TOPDIR%") DO set TOPDIR=%%~fI + +if /i "%GOTOHELP%" == "yes" goto :help +GOTO :start + + +:help + +echo. +echo Installs or restores F# SDK bits, which applies system-wide to all Visual Studio +echo 2017 installations. After running this, each project targeting F# 4.1 will use +echo your locally built FSC.exe. It will not update other F# tools, see remarks below. +echo. +echo Requires Administrator privileges for removing/restoring strong-naming. +echo. +echo Syntax: %0 [debug^|release^|restore^|backup] +echo. +echo debug integrates debug builds of FSC, FSI ^& tools +echo release integrates release builds of FSC, FSI ^& tools +echo restore restores original SDK from an earlier backup +echo backup backups the files that would be overwritten, does not deploy anything +echo. +echo Paths used: +echo. +echo Root location: %TOPDIR% +echo Debug bin location: %TOPDIR%\debug\net40\bin +echo Release bin location: %TOPDIR%\release\net40\bin +echo Backup location: %RESTOREDIR% +echo. +echo Remarks: +echo. +echo This script should only be run after build.cmd has completed successfully. +echo. +echo Clearing the git repository may clear the backup directory. To be on the safe +echo side, you should place a copy of the backup dir outside of the git repo. +echo. +echo This batch script will only update the relevant SDK bits, and remove or restore +echo strong-naming automatically. It is recommended that you also update the F# Tools +echo by running the following two commands after a build of "build vs" or +echo "build vs debug" has completed. More instructions in DEVGUIDE.md in the root. +echo. +echo For Release builds: +echo. +echo ^> VSIXInstaller.exe /u:"VisualFSharp" +echo ^> VSIXInstaller.exe release\net40\bin\VisualFSharpOpenSource.vsix +echo. +echo For Debug builds: +echo. +echo ^> VSIXInstaller.exe /u:"VisualFSharp" +echo ^> VSIXInstaller.exe debug\net40\bin\VisualFSharpOpenSource.vsix +echo. + +exit /b 1 + +:start + +echo. +if "%DEPLOY%" == "yes" echo Starting deployment of %ACTION% bits. +if not "%DEPLOY%" == "yes" echo Starting %ACTION% +echo. + +rem This check whether we're started with administrator rights +CALL :checkPrequisites + if /i "%PROCESSOR_ARCHITECTURE%"=="x86" set X86_PROGRAMFILES=%ProgramFiles% if /I "%PROCESSOR_ARCHITECTURE%"=="AMD64" set X86_PROGRAMFILES=%ProgramFiles(x86)% set REGEXE32BIT=reg.exe if not "%OSARCH%"=="x86" set REGEXE32BIT=%WINDIR%\syswow64\reg.exe - FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B -if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder') DO SET WINSDKNETFXTOOLS=%%B +rem See https://stackoverflow.com/a/17113667/111575 on 2^>NUL for suppressing the error "ERROR: The system was unable to find the specified registry key or value." from reg.exe, this fixes #3619 +rem The delims are a TAB and a SPACE, do not normalize it! + FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.2\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\WOW6432Node\Microsoft\Microsoft SDKs\NETFXSDK\4.6.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\NETFXSDK\4.6\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.1A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v8.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.1\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B +if "%WINSDKNETFXTOOLS%"=="" FOR /F "tokens=2* delims= " %%A IN ('%REGEXE32BIT% QUERY "HKLM\Software\Microsoft\Microsoft SDKs\Windows\v7.0A\WinSDK-NetFx40Tools" /v InstallationFolder 2^>NUL') DO SET WINSDKNETFXTOOLS=%%B set SN32="%WINSDKNETFXTOOLS%sn.exe" set SN64="%WINSDKNETFXTOOLS%x64\sn.exe" @@ -42,112 +161,510 @@ set NGEN64=%windir%\Microsoft.NET\Framework64\v4.0.30319\ngen.exe set FSHARPVERSION=4.1 set FSHARPVERSION2=41 +rem The various locations of the SDK and tools + +rem SDK path, will be created if it doesn't exist set COMPILERSDKPATH=%X86_PROGRAMFILES%\Microsoft SDKs\F#\%FSHARPVERSION%\Framework\v4.0 -mkdir "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsc.exe" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsc.exe.config" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\FSharp.Build.dll" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\FSharp.Compiler.Private.dll" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\FSharp.Compiler.Interactive.Settings.dll" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsi.exe" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsi.exe.config" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsiAnyCpu.exe" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\fsiAnyCpu.exe.config" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\Microsoft.FSharp.Targets" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\Microsoft.Portable.FSharp.Targets" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\Microsoft.FSharp.NetSdk.props" "%COMPILERSDKPATH%" -copy /y "%BINDIR%\Microsoft.FSharp.NetSdk.targets" "%COMPILERSDKPATH%" -copy /y "%TOPDIR%\vsintegration\src\SupportedRuntimes\SupportedRuntimes.xml" "%COMPILERSDKPATH%" +rem Main assemblies path, will be created if it doesn't exist set COMPILERMAINASSEMBLIESPATH=%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0 -mkdir "%COMPILERMAINASSEMBLIESPATH%" -copy /y "%BINDIR%\FSharp.Core.dll" "%COMPILERMAINASSEMBLIESPATH%" -copy /y "%BINDIR%\FSharp.Core.optdata" "%COMPILERMAINASSEMBLIESPATH%" -copy /y "%BINDIR%\FSharp.Core.sigdata" "%COMPILERMAINASSEMBLIESPATH%" -copy /y "%BINDIR%\FSharp.Core.xml" "%COMPILERMAINASSEMBLIESPATH%" +rem The .NET Core 3.7 assemblies path, will be created if it doesn't exist set COMPILER7ASSEMBLIESPATH=%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETCore\3.7.%FSHARPVERSION2%.0 -mkdir "%COMPILER7ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable7\bin\FSharp.Core.dll" "%COMPILER7ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable7\bin\FSharp.Core.optdata" "%COMPILER7ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable7\bin\FSharp.Core.sigdata" "%COMPILER7ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable7\bin\FSharp.Core.xml" "%COMPILER7ASSEMBLIESPATH%" +rem The .NET Core 3.78 assemblies path, will be created if it doesn't exist set COMPILER78ASSEMBLIESPATH=%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETCore\3.78.%FSHARPVERSION2%.0 -mkdir "%COMPILER78ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable78\bin\FSharp.Core.dll" "%COMPILER78ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable78\bin\FSharp.Core.optdata" "%COMPILER78ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable78\bin\FSharp.Core.sigdata" "%COMPILER78ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable78\bin\FSharp.Core.xml" "%COMPILER78ASSEMBLIESPATH%" +rem The .NET Core 3.259 assemblies path, will be created if it doesn't exist set COMPILER259ASSEMBLIESPATH=%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETCore\3.259.%FSHARPVERSION2%.0 -mkdir "%COMPILER259ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable259\bin\FSharp.Core.dll" "%COMPILER259ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable259\bin\FSharp.Core.optdata" "%COMPILER259ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable259\bin\FSharp.Core.sigdata" "%COMPILER259ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable259\bin\FSharp.Core.xml" "%COMPILER259ASSEMBLIESPATH%" +rem The .NET Portable 3.47 assemblies path, will be created if it doesn't exist set COMPILER47ASSEMBLIESPATH=%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETPortable\3.47.%FSHARPVERSION2%.0 -mkdir "%COMPILER47ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable47\bin\FSharp.Core.dll" "%COMPILER47ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable47\bin\FSharp.Core.optdata" "%COMPILER47ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable47\bin\FSharp.Core.sigdata" "%COMPILER47ASSEMBLIESPATH%" -copy /y "%BINDIR%\..\..\portable47\bin\FSharp.Core.xml" "%COMPILER47ASSEMBLIESPATH%" +rem Try to create target and backup folders, if needed +set RESTOREBASE=%RESTOREDIR% + +rem Only create backup dirs if we are backupping or restoring +rem (in the latter case, the directories should already be there, but if not, it prevents errors later on) +if "!DEPLOY!" == "no" ( + CALL :tryCreateFolder "!RESTOREBASE!\compiler_sdk" + CALL :tryCreateFolder "!RESTOREBASE!\main_assemblies" + CALL :tryCreateFolder "!RESTOREBASE!\profile_7" + CALL :tryCreateFolder "!RESTOREBASE!\profile_78" + CALL :tryCreateFolder "!RESTOREBASE!\profile_259" + CALL :tryCreateFolder "!RESTOREBASE!\profile_47" +) +CALL :tryCreateFolder "!COMPILERSDKPATH!" +CALL :tryCreateFolder "!COMPILERMAINASSEMBLIESPATH!" +CALL :tryCreateFolder "!COMPILER7ASSEMBLIESPATH!" & +CALL :tryCreateFolder "!COMPILER78ASSEMBLIESPATH!" +CALL :tryCreateFolder "!COMPILER259ASSEMBLIESPATH!" +CALL :tryCreateFolder "!COMPILER47ASSEMBLIESPATH!" + +rem If one or more directories could not be created, exit early with a non-zero error code +if "!CREATEFAILED!"=="true" CALL :exitFailDir & EXIT /B 1 + +rem Deploying main files, fsi.exe and fsc.exe and related + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for compiler_sdk" & echo. + +set SOURCEDIR=%BINDIR% +set RESTOREDIR=!RESTOREBASE!\compiler_sdk +CALL :checkAvailability compiler_sdk +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy fsc.exe "!COMPILERSDKPATH!" + CALL :backupAndOrCopy fsc.exe.config "%COMPILERSDKPATH%" + CALL :backupAndOrCopy FSharp.Build.dll "%COMPILERSDKPATH%" + CALL :backupAndOrCopy FSharp.Compiler.Private.dll "%COMPILERSDKPATH%" + CALL :backupAndOrCopy FSharp.Compiler.Interactive.Settings.dll "%COMPILERSDKPATH%" + CALL :backupAndOrCopy fsi.exe "%COMPILERSDKPATH%" + CALL :backupAndOrCopy fsi.exe.config "%COMPILERSDKPATH%" + CALL :backupAndOrCopy fsiAnyCpu.exe "%COMPILERSDKPATH%" + CALL :backupAndOrCopy fsiAnyCpu.exe.config "%COMPILERSDKPATH%" + CALL :backupAndOrCopy Microsoft.FSharp.Targets "%COMPILERSDKPATH%" + CALL :backupAndOrCopy Microsoft.Portable.FSharp.Targets "%COMPILERSDKPATH%" + CALL :backupAndOrCopy Microsoft.FSharp.NetSdk.props "%COMPILERSDKPATH%" + CALL :backupAndOrCopy Microsoft.FSharp.NetSdk.targets "%COMPILERSDKPATH%" + + rem Special casing for SupportedRuntimes.xml, it has a different source directory, it's always there + set SOURCEDIR="%TOPDIR%\vsintegration\src\SupportedRuntimes" + CALL :backupAndOrCopy SupportedRuntimes.xml "%COMPILERSDKPATH%" +) + + + +rem Deploying main assemblies + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for main_assemblies" & echo. + +set SOURCEDIR=%BINDIR% +set RESTOREDIR=!RESTOREBASE!\main_assemblies +CALL :checkAvailability main_assemblies +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy FSharp.Core.dll "%COMPILERMAINASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.optdata "%COMPILERMAINASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.sigdata "%COMPILERMAINASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.xml "%COMPILERMAINASSEMBLIESPATH%" +) + + +rem Deploying for .NET Core 3.7 + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for profile_7" & echo. + +set SOURCEDIR=%BINDIR%\..\..\portable7\bin +set RESTOREDIR=!RESTOREBASE!\profile_7 +CALL :checkAvailability profile_7 +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy FSharp.Core.dll "%COMPILER7ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.optdata "%COMPILER7ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.sigdata "%COMPILER7ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.xml "%COMPILER7ASSEMBLIESPATH%" +) + + +rem Deploying for .NET Core 3.78 + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for profile_78" & echo. + +set SOURCEDIR=%BINDIR%\..\..\portable78\bin +set RESTOREDIR=!RESTOREBASE!\profile_78 +CALL :checkAvailability profile_78 +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy FSharp.Core.dll "%COMPILER78ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.optdata "%COMPILER78ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.sigdata "%COMPILER78ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.xml "%COMPILER78ASSEMBLIESPATH%" +) + + +rem Deploying for .NET Core 3.259 + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for profile_259" & echo. + +set SOURCEDIR=%BINDIR%\..\..\portable259\bin +set RESTOREDIR=!RESTOREBASE!\profile_259 +CALL :checkAvailability profile_259 +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy FSharp.Core.dll "%COMPILER259ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.optdata "%COMPILER259ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.sigdata "%COMPILER259ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.xml "%COMPILER259ASSEMBLIESPATH%" +) + + +rem Deploying for .NET Portable 3.47 + +echo. +CALL :colorEcho 02 "[!ACTION!] Processing files for profile_47" & echo. + +set SOURCEDIR=%BINDIR%\..\..\portable47\bin +set RESTOREDIR=!RESTOREBASE!\profile_47 +CALL :checkAvailability profile_47 +if "!BIN_AVAILABLE!" == "true" ( + CALL :backupAndOrCopy FSharp.Core.dll "%COMPILER47ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.optdata "%COMPILER47ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.sigdata "%COMPILER47ASSEMBLIESPATH%" + CALL :backupAndOrCopy FSharp.Core.xml "%COMPILER47ASSEMBLIESPATH%" +) + +REM TODO: this was already here (2017-09-28) and was already commented out, I think (AB) that these redirects aren't necessary anymore and can be permanently removed REM echo ^^^^^ ^^^^^ > "%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0\pub.config" -if /I "%PROCESSOR_ARCHITECTURE%"=="AMD64" ( - REG ADD "HKLM\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\F# %FSHARPVERSION% Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0\ - REG ADD "HKLM\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v4.0.50709\AssemblyFoldersEx\F# %FSHARPVERSION% Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0\ -) -REG ADD "HKLM\SOFTWARE\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\F# %FSHARPVERSION% Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0\ -REG ADD "HKLM\SOFTWARE\Microsoft\.NETFramework\v4.0.50709\AssemblyFoldersEx\F# %FSHARPVERSION% Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "%X86_PROGRAMFILES%\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.%FSHARPVERSION%.0\ - -rem Disable strong-name validation for F# binaries built from open source that are signed with the microsoft key -%SN32% -Vr FSharp.Core,b03f5f7f11d50a3a -%SN32% -Vr FSharp.Build,b03f5f7f11d50a3a -%SN32% -Vr FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a -%SN32% -Vr HostedCompilerServer,b03f5f7f11d50a3a - -%SN32% -Vr FSharp.Compiler,b03f5f7f11d50a3a -%SN32% -Vr FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a -%SN32% -Vr FSharp.Editor,b03f5f7f11d50a3a -%SN32% -Vr FSharp.LanguageService,b03f5f7f11d50a3a -%SN32% -Vr FSharp.LanguageService.Base,b03f5f7f11d50a3a -%SN32% -Vr FSharp.ProjectSystem.Base,b03f5f7f11d50a3a -%SN32% -Vr FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a -%SN32% -Vr FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a -%SN32% -Vr FSharp.VS.FSI,b03f5f7f11d50a3a -%SN32% -Vr VisualFSharp.Unittests,b03f5f7f11d50a3a -%SN32% -Vr VisualFSharp.Salsa,b03f5f7f11d50a3a - -if /i "%PROCESSOR_ARCHITECTURE%"=="AMD64" ( - %SN64% -Vr FSharp.Core,b03f5f7f11d50a3a - %SN64% -Vr FSharp.Build,b03f5f7f11d50a3a - %SN64% -Vr FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a - %SN64% -Vr HostedCompilerServer,b03f5f7f11d50a3a - - %SN64% -Vr FSharp.Compiler,b03f5f7f11d50a3a - %SN64% -Vr FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a - %SN64% -Vr FSharp.Editor,b03f5f7f11d50a3a - %SN64% -Vr FSharp.LanguageService,b03f5f7f11d50a3a - %SN64% -Vr FSharp.LanguageService.Base,b03f5f7f11d50a3a - %SN64% -Vr FSharp.ProjectSystem.Base,b03f5f7f11d50a3a - %SN64% -Vr FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a - %SN64% -Vr FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a - %SN64% -Vr FSharp.VS.FSI,b03f5f7f11d50a3a - %SN64% -Vr VisualFSharp.Unittests,b03f5f7f11d50a3a - %SN64% -Vr VisualFSharp.Salsa,b03f5f7f11d50a3a -) - -rem NGen fsc, fsi, fsiAnyCpu, and FSharp.Build.dll - -"%NGEN32%" install "%COMPILERSDKPATH%\fsc.exe" /queue:1 -"%NGEN32%" install "%COMPILERSDKPATH%\fsi.exe" /queue:1 -"%NGEN32%" install "%COMPILERSDKPATH%\fsiAnyCpu.exe" /queue:1 -"%NGEN32%" install "%COMPILERSDKPATH%\FSharp.Build.dll" /queue:1 - -if /i "%PROCESSOR_ARCHITECTURE%"=="AMD64" ( - "%NGEN64%" install "%COMPILERSDKPATH%\fsiAnyCpu.exe" /queue:1 - "%NGEN64%" install "%COMPILERSDKPATH%\FSharp.Build.dll" /queue:1 +rem To add registry keys and to change strong-name validation requires Administrator access + +if "%DEPLOY%" == "yes" if "!ISADMIN!" == "yes" ( + echo. + CALL :colorEcho 02 "[!ACTION!] Setting or adding registry keys for open source assemblies" & echo. + if /I "!PROCESSOR_ARCHITECTURE!"=="AMD64" ( + REG ADD "HKLM\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\F# !FSHARPVERSION! Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "!X86_PROGRAMFILES!\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.!FSHARPVERSION!.0\ + REG ADD "HKLM\SOFTWARE\Wow6432Node\Microsoft\.NETFramework\v4.0.50709\AssemblyFoldersEx\F# !FSHARPVERSION! Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "!X86_PROGRAMFILES!\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.!FSHARPVERSION!.0\ + ) + REG ADD "HKLM\SOFTWARE\Microsoft\.NETFramework\v4.0.30319\AssemblyFoldersEx\F# !FSHARPVERSION! Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "!X86_PROGRAMFILES!\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.!FSHARPVERSION!.0\ + REG ADD "HKLM\SOFTWARE\Microsoft\.NETFramework\v4.0.50709\AssemblyFoldersEx\F# !FSHARPVERSION! Core Assemblies (Open Source)" /ve /t REG_SZ /f /d "!X86_PROGRAMFILES!\Reference Assemblies\Microsoft\FSharp\.NETFramework\v4.0\4.!FSHARPVERSION!.0\ + + rem Disable strong-name validation for F# binaries built from open source that are signed with the microsoft key + echo. + CALL :colorEcho 02 "[!ACTION!] Removing strong-name validation of F# binaries" & echo. + !SN32! -Vr FSharp.Core,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.Build,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr HostedCompilerServer,b03f5f7f11d50a3a 1>NUL 2>NUL + + !SN32! -Vr FSharp.Compiler,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.Editor,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.LanguageService,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.LanguageService.Base,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.ProjectSystem.Base,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr FSharp.VS.FSI,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr VisualFSharp.Unittests,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN32! -Vr VisualFSharp.Salsa,b03f5f7f11d50a3a 1>NUL 2>NUL + + REM Do this *in addition* to the above for x64 systems + if /i "!PROCESSOR_ARCHITECTURE!"=="AMD64" ( + !SN64! -Vr FSharp.Core,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.Build,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr HostedCompilerServer,b03f5f7f11d50a3a 1>NUL 2>NUL + + !SN64! -Vr FSharp.Compiler,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.Editor,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.LanguageService,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.LanguageService.Base,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.ProjectSystem.Base,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr FSharp.VS.FSI,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr VisualFSharp.Unittests,b03f5f7f11d50a3a 1>NUL 2>NUL + !SN64! -Vr VisualFSharp.Salsa,b03f5f7f11d50a3a 1>NUL 2>NUL + ) + + rem NGen fsc, fsi, fsiAnyCpu, and FSharp.Build.dll + + echo. + CALL :colorEcho 02 "[!ACTION!] Queuing for NGEN of FSI and FSC binaries" & echo. + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsc.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsc.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsi.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsi.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsiAnyCpu.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsiAnyCpu.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\FSharp.Build.dll" + "!NGEN32!" install "!COMPILERSDKPATH!\FSharp.Build.dll" /queue:1 1>NUL + + if /i "!PROCESSOR_ARCHITECTURE!"=="AMD64" ( + echo [!ACTION!] NGEN64 of "!COMPILERSDKPATH!\fsiAnyCpu.exe" + "!NGEN64!" install "!COMPILERSDKPATH!\fsiAnyCpu.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN64 of "!COMPILERSDKPATH!\FSharp.Build.dll" + "!NGEN64!" install "!COMPILERSDKPATH!\FSharp.Build.dll" /queue:1 1>NUL + ) +) + +if "%DEPLOY%" == "yes" if "!ISADMIN!" == "no" ( + echo. + CALL :colorEcho 0E "[!ACTION!] SKIPPED (no admin) Setting or adding registry keys for open source assemblies" & echo. + CALL :colorEcho 0E "[!ACTION!] SKIPPED (no admin) Removing strong-name validation of F# binaries" & echo. + CALL :colorEcho 02 "[!ACTION!] SKIPPED (no admin) Queuing for NGEN of FSI and FSC binaries" & echo. + SET /A WARNCOUNT+=3 +) + +rem Re-enable certain settings when restoring, NGEN the original files again, requires admin rights +if "%ACTION%" == "restore" if "!ISADMIN!" == "yes" ( + + rem Re-enable strong-name validation for F# binaries that were previously installed + echo. + CALL :colorEcho 02 "[!ACTION!] Re-enabling strong-name validation of original F# binaries" & echo. + !SN32! -Vu FSharp.Core,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.Build,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu HostedCompilerServer,b03f5f7f11d50a3a 2>NUL 1>NUL + + !SN32! -Vu FSharp.Compiler,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.Editor,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.LanguageService,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.LanguageService.Base,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.ProjectSystem.Base,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu FSharp.VS.FSI,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu VisualFSharp.Unittests,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN32! -Vu VisualFSharp.Salsa,b03f5f7f11d50a3a 2>NUL 1>NUL + + REM Do this *in addition* to the above for x64 systems + if /i "!PROCESSOR_ARCHITECTURE!"=="AMD64" ( + !SN64! -Vu FSharp.Core,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.Build,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.Compiler.Interactive.Settings,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu HostedCompilerServer,b03f5f7f11d50a3a 2>NUL 1>NUL + + !SN64! -Vu FSharp.Compiler,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.Compiler.Server.Shared,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.Editor,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.LanguageService,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.LanguageService.Base,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.ProjectSystem.Base,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.ProjectSystem.FSharp,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.ProjectSystem.PropertyPages,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu FSharp.VS.FSI,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu VisualFSharp.Unittests,b03f5f7f11d50a3a 2>NUL 1>NUL + !SN64! -Vu VisualFSharp.Salsa,b03f5f7f11d50a3a 2>NUL 1>NUL + ) + + rem NGen fsc, fsi, fsiAnyCpu, and FSharp.Build.dll + + echo. + CALL :colorEcho 02 "[!ACTION!] Queuing for NGEN of FSI and FSC binaries" & echo. + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsc.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsc.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsi.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsi.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\fsiAnyCpu.exe" + "!NGEN32!" install "!COMPILERSDKPATH!\fsiAnyCpu.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN of "!COMPILERSDKPATH!\FSharp.Build.dll" + "!NGEN32!" install "!COMPILERSDKPATH!\FSharp.Build.dll" /queue:1 1>NUL + + if /i "!PROCESSOR_ARCHITECTURE!"=="AMD64" ( + echo [!ACTION!] NGEN64 of "!COMPILERSDKPATH!\fsiAnyCpu.exe" + "!NGEN64!" install "!COMPILERSDKPATH!\fsiAnyCpu.exe" /queue:1 1>NUL + echo [!ACTION!] NGEN64 of "!COMPILERSDKPATH!\FSharp.Build.dll" + "!NGEN64!" install "!COMPILERSDKPATH!\FSharp.Build.dll" /queue:1 1>NUL + ) +) + +if "%ACTION%" == "restore" if "!ISADMIN!" == "no" ( + CALL :colorEcho 0E "[!ACTION!] SKIPPED (no admin) Re-enabling strong-name validation of original F# binaries" & echo. + CALL :colorEcho 0E "[!ACTION!] SKIPPED (no admin) Queuing for NGEN of FSI and FSC binaries" & echo. + set /A WARNCOUNT+=2 +) +GOTO :summary + +:checkAvailability +rem Checks whether a given source is available, issues a warning otherwise, SOURCEDIR must be set to the appropriate binaries + +rem This will simultaneously remove the quotes of the original param and add the filename to it, then it is surrounded by quotes again +FOR /F "usebackq tokens=*" %%I IN ('%SOURCEDIR%') DO set SOURCE="%%~fI\*" +if not exist !SOURCE! ( + rem For debug and release deploy it matters, but for restore and backup we don't care + set BIN_AVAILABLE=true + if "!DEPLOY!" == "yes" ( + echo [!ACTION!] Source bindir does not exist: !SOURCE! + CALL :colorEcho 0E "[!ACTION!] Source binaries not found, deploy of %1 skipped" & echo. & set /A WARNCOUNT+=1 + set BIN_AVAILABLE=false + ) + +) else ( + set BIN_AVAILABLE=true ) + +EXIT /B + + +:backupAndOrCopy +rem Creates a backup and copies, depending on whether debug, release, restore or backup is selected + +rem This will simultaneously remove the quotes of the original param and add the filename to it, then it is surrounded by quotes again +FOR /F "usebackq tokens=*" %%I IN ('%2') DO set TARGET="%%~fI\%1" +FOR /F "usebackq tokens=*" %%I IN ('%RESTOREDIR%') DO set BACKUP="%%~fI\%1" +FOR /F "usebackq tokens=*" %%I IN ('%SOURCEDIR%') DO set SOURCE="%%~fI\%1" + +if "%ACTION%" == "backup" ( + rem When backing up, the target becomes the source + + if not exist !TARGET! ( + rem Remove a file from the backup location if it is not part of this SDK install + DEL /f !BACKUP! 1>NUL 2>NUL + ) else ( + rem Otherwise, copy over the original + CALL :copyFile !TARGET! !BACKUP! + ) +) + +if "%ACTION%" == "restore" ( + rem When restoring, the backup location becomes the source + + if not exist !BACKUP! ( + rem If this file didn't exist in the previous installation, we should remove it to prevent confusion of left-over bits + DEL /f !TARGET! 1>NUL 2>NUL + ) else ( + rem Otherwise, copy over the original + CALL :copyFile !BACKUP! !TARGET! + ) +) + +if "%DEPLOY%" == "yes" ( + rem Deploy of debug or release build, depending on selected action + CALL :copyFile !SOURCE! !TARGET! +) + + +EXIT /B + +rem Copies a file and logs errors in red, warnings in yellow +:copyFile +FOR /F "usebackq tokens=*" %%I IN ('%1') DO set SOURCE="%%~fI" +FOR /F "usebackq tokens=*" %%I IN ('%2') DO set TARGET="%%~fI" + +echo [%ACTION%] source: !SOURCE! +echo [%ACTION%] target: !TARGET! +if EXIST !SOURCE! ( + copy /y !SOURCE! !TARGET! 1>NUL 2>copyresult.log + if "!errorlevel!" == "0" echo [!ACTION!] 1 file copied & set /A COPYCOUNT+=1 + if not "!errorlevel!" == "0" ( + set /p COPYRESULT=nul + set COPYRESULT= +) else ( + if "%ACTION%" == "backup" CALL [backup] File not found, nothing to backup + if "%ACTION%" == "restore" CALL :colorEcho 0E "[restore] File not found, not able to restore, possibly it didn't exist originally" & echo. & set /A WARNCOUNT+=1 + if "%DEPLOY%" == "yes" CALL :colorEcho 0C "[!ACTION!] File not found, not able to deploy" & echo. & set /A ERRORCOUNT+=1 +) + +EXIT /B + +rem Creates a folder, if it already exists, it will do nothing, if there's an access-denied, it will set %CREATEFAILED% to true +:tryCreateFolder + +rem Add a backslash safely, by taking care of auxiliary quotes +FOR /F "usebackq tokens=*" %%I IN ('%1') DO set FOLDER_TO_BE_CREATED="%%~fI\" + +if not exist !FOLDER_TO_BE_CREATED! ( + mkdir !FOLDER_TO_BE_CREATED! 2>NUL + if "!errorlevel!" EQU "0" ( + echo [!ACTION!] Created directory !FOLDER_TO_BE_CREATED! + ) else ( + set CREATEFAILED=true + echo Failed to create %1 + CALL :colorEcho 0C "Could not create directory, check access rights or whether a file with that name exists " + echo. + echo. + ) +) + +EXIT /B + +:summary + +echo. +if not "%ACTION%" == "restore" if not "%ACTION%" == "backup" echo Finished installing F# SDK and other bits. The following directories were updated and & echo a backup is written to %RESTOREDIR%. +if "%ACTION%" == "restore" echo Finished restoring original F# SDK and other bits. The following directories were used while & echo restoring a backup from %RESTOREDIR%. +if "%ACTION%" == "backup" echo Finished creating a backup in %RESTOREBASE%. + +echo. +echo Root location: %TOPDIR% +if "!ACTION!" == "debug" echo Debug bin location: %TOPDIR%\debug\net40\bin +if "!ACTION!" == "release" echo Release bin location: %TOPDIR%\release\net40\bin +if "!DEPLOY!" == "no" echo Backup location: %RESTOREBASE% +echo. +echo Target locations used: +echo. +echo Win SDK tools: %WINSDKNETFXTOOLS% +echo Compiler SDK path: %COMPILERSDKPATH% +echo F# compiler main assemblies: %COMPILERMAINASSEMBLIESPATH% +echo Portable profile 7: %COMPILER7ASSEMBLIESPATH% +echo Portable profile 78: %COMPILER78ASSEMBLIESPATH% +echo Portable profile 259: %COMPILER259ASSEMBLIESPATH% +echo Portable profile 47: %COMPILER47ASSEMBLIESPATH% +echo. + +rem Display success, warning, error counts + +if "%ACTION%" == "backup" SET VERB=backed up +if "%ACTION%" == "restore" SET VERB=restored +if "%DEPLOY%" == "yes" SET VERB=deployed +CALL :colorEcho 0A "A total of %COPYCOUNT% file(s) were %VERB%." & echo. + +if %ERRORCOUNT% equ 1 CALL :colorEcho 0C "%ERRORCOUNT% error reported, see log" & echo. +if %ERRORCOUNT% gtr 1 CALL :colorEcho 0C "%ERRORCOUNT% errors reported, see log" & echo. +if %ERRORCOUNT% equ 0 CALL :colorEcho 0A "No errors reported" & echo. + +if %WARNCOUNT% equ 1 CALL :colorEcho 0E "%WARNCOUNT% warning reported, see log" & echo. +if %WARNCOUNT% gtr 1 CALL :colorEcho 0E "%WARNCOUNT% warnings reported, see log" & echo. +if %WARNCOUNT% equ 0 CALL :colorEcho 0A "No warnings reported" & echo. + +rem Return non-zero error code for use-cases where this script is called from other scripts +if %ERRORCOUNT% gtr 0 EXIT /B 1 +EXIT /B 0 + +GOTO :EOF + +:exitFailDir + +echo. +CALL :colorEcho 0C "One or more directories failed to be created. No files have been copied." & echo. +echo. +echo Possible causes include: +echo - Insufficient rights to create directories in this folder +echo - A file with that name already exists +echo. +echo No error is raised if the directory exists. +echo No files were copied or backed up. +echo. + +rem Return non-zero error code for use-cases where this script is called from other scripts +EXIT /B 1 + +:checkPrequisites +rem Whether or not we have administrator rights + +SET ISADMIN=yes + +rem The error level of NET SESSION is set to 2 when you don't have administrator rights, simplest hack +net sessions 1>NUL 2>NUL +if %ERRORLEVEL% GTR 0 ( + SET ISADMIN=no + CALL :colorEcho 0E "[!ACTION!] Started without administrator access, strong-naming will not be adjusted, reg-keys not changed" & echo. + SET /A WARNCOUNT+=1 +) + +EXIT /B + + +rem See: https://stackoverflow.com/a/21666354/111575 +rem Prevent accidentally entering the colorEcho label +GOTO :EOF +:colorEcho + "%~2" +findstr /v /a:%1 /R "^$" "%~2" nul +del "%~2" > nul 2>&1i \ No newline at end of file From a83598dbd2e51fbe584f105c67367707a5b085e1 Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Wed, 11 Oct 2017 22:18:21 -0700 Subject: [PATCH 2/5] move `GenerateSource` attributes to be elements This fixes build issues when older versions of MSBuild are used. --- vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj | 3 ++- .../src/FSharp.LanguageService/FSharp.LanguageService.fsproj | 3 ++- .../src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj | 3 ++- vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj | 3 ++- 4 files changed, 8 insertions(+), 4 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index bde8237c08..25c8ea3020 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -29,7 +29,8 @@ true - + + true Microsoft.VisualStudio.FSharp.Editor.SR diff --git a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj index 96ed9e9404..7cacb5885e 100644 --- a/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj +++ b/vsintegration/src/FSharp.LanguageService/FSharp.LanguageService.fsproj @@ -50,7 +50,8 @@ false - + + true Microsoft.VisualStudio.FSharp.LanguageService.Strings diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj index 077dbc4d30..d475e39d0d 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/ProjectSystem.fsproj @@ -79,7 +79,8 @@ 210 - + + true Microsoft.VisualStudio.FSharp.ProjectSystem.FSharpSR true diff --git a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj index 080745543a..674dd16937 100644 --- a/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj +++ b/vsintegration/src/FSharp.VS.FSI/FSHarp.VS.FSI.fsproj @@ -60,7 +60,8 @@ - + + true Microsoft.VisualStudio.FSharp.Interactive.SRProperties true Properties From 2ccf874a50615620a7cf0281b6ce54371bdaf7f2 Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Thu, 12 Oct 2017 14:17:06 -0700 Subject: [PATCH 3/5] publish templates VSIX (#3741) --- setup/Swix/Microsoft.FSharp.vsmanproj | 1 + setup/fsharp-setup-build.proj | 1 + 2 files changed, 2 insertions(+) diff --git a/setup/Swix/Microsoft.FSharp.vsmanproj b/setup/Swix/Microsoft.FSharp.vsmanproj index bf402370b5..5b787bff30 100644 --- a/setup/Swix/Microsoft.FSharp.vsmanproj +++ b/setup/Swix/Microsoft.FSharp.vsmanproj @@ -21,6 +21,7 @@ + diff --git a/setup/fsharp-setup-build.proj b/setup/fsharp-setup-build.proj index a349b1c3dd..c220083254 100644 --- a/setup/fsharp-setup-build.proj +++ b/setup/fsharp-setup-build.proj @@ -51,6 +51,7 @@ + From 9fc3952ae7740f55f48563fdccfce76c95bad1c3 Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Fri, 13 Oct 2017 11:52:35 -0700 Subject: [PATCH 4/5] undo #3536 (#3746) (#3749) * undo https://github.com/Microsoft/visualfsharp/pull/3536 * undo https://github.com/Microsoft/visualfsharp/pull/3536 --- src/fsharp/LowerCallsAndSeqs.fs | 3 ++- tests/fsharp/core/seq/test.fsx | 19 +++++++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 7e6ba07fed..9dfde6b638 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -394,6 +394,7 @@ let LowerSeqExpr g amap overallExpr = | None -> None +(* | Expr.LetRec(binds,e2,m,_) when // Restriction: only limited forms of "let rec" in sequence expressions can be handled by assignment to state local values @@ -422,7 +423,7 @@ let LowerSeqExpr g amap overallExpr = Some res4 | None -> None - +*) | Expr.Match (spBind,exprm,pt,targets,m,ty) when targets |> Array.forall (fun (TTarget(vs,_e,_spTarget)) -> isNil vs) -> // lower all the targets. abandon if any fail to lower let tgl = targets |> Array.map (fun (TTarget(_vs,e,_spTarget)) -> Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e) |> Array.toList diff --git a/tests/fsharp/core/seq/test.fsx b/tests/fsharp/core/seq/test.fsx index ab6e84be36..b1a59d8b58 100644 --- a/tests/fsharp/core/seq/test.fsx +++ b/tests/fsharp/core/seq/test.fsx @@ -572,6 +572,7 @@ module InfiniteSequenceExpressionsExecuteWithFiniteResources = yield! seqThreeRecCapturingOne r } + // // These tests will stackoverflow or out-of-memory if the above functions are not compiled to "sequence epression tailcalls", // i.e. by compiling them to a state machine let tests() = @@ -697,8 +698,22 @@ module InfiniteSequenceExpressionsExecuteWithFiniteResources = *) -InfiniteSequenceExpressionsExecuteWithFiniteResources.tests() - +// Tests disabled due to bug https://github.com/Microsoft/visualfsharp/issues/3743 +//InfiniteSequenceExpressionsExecuteWithFiniteResources.tests() + + // This is the additional test case related to bug https://github.com/Microsoft/visualfsharp/issues/3743 + let TestRecFuncInSeq() = + let factorials = + [ for x in 0..10 do + let rec factorial x = + match x with + | 0 -> 1 + | x -> x * factorial(x - 1) + yield factorial x + ] + + for f in factorials do printf "%i" f + TestRecFuncInSeq() (*--------------------------------------------------------------------------- !* wrap up From 69ac9afcc4bcd879f437dbd34c621b3c621c7265 Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Tue, 17 Oct 2017 14:09:45 -0700 Subject: [PATCH 5/5] copy VisualFSharpTemplate.vsix to the insertion directory (#3767) --- setup/fsharp-setup-build.proj | 1 + 1 file changed, 1 insertion(+) diff --git a/setup/fsharp-setup-build.proj b/setup/fsharp-setup-build.proj index c220083254..df93c2e6f5 100644 --- a/setup/fsharp-setup-build.proj +++ b/setup/fsharp-setup-build.proj @@ -50,6 +50,7 @@ +