diff --git a/.gitattributes b/.gitattributes index a0a6f27928..db017a84e9 100644 --- a/.gitattributes +++ b/.gitattributes @@ -25,3 +25,5 @@ targets.make text eol=lf *.bsl linguist-vendored=true + +*.png binary diff --git a/.gitignore b/.gitignore index fe10c6d0bb..ef4d829be1 100644 --- a/.gitignore +++ b/.gitignore @@ -192,6 +192,9 @@ tests/fsharpqa/Source/*FSharpQA_Failures.lst FSharp.Compiler.Tools.Nuget/*.nupkg FSharp.Core.Nuget/*.nupkg artifacts/*.nupkg +*.bak +*.vserr +*.err *.orig *.mdf *.ldf @@ -221,7 +224,6 @@ source_link.json System.ValueTuple.dll tests/fsharpqa/testenv/bin/System.ValueTuple.dll lib/netcore/fsc/bin/ - !lib/bootstrap/signed/**/* */.fake /fcs/packages/ diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props index 534ba96c04..c9e761c997 100644 --- a/FSharp.Profiles.props +++ b/FSharp.Profiles.props @@ -6,42 +6,23 @@ $(DefineConstants);CROSS_PLATFORM_COMPILER $(DefineConstants);ENABLE_MONO_SUPPORT $(DefineConstants);BE_SECURITY_TRANSPARENT - $(DefineConstants);FX_LCIDFROMCODEPAGE $(DefineConstants);NETSTANDARD $(DefineConstants);FX_NO_APP_DOMAINS - $(DefineConstants);FX_NO_ARRAY_LONG_LENGTH - $(DefineConstants);FX_NO_BEGINEND_READWRITE - $(DefineConstants);FX_NO_BINARY_SERIALIZATION - $(DefineConstants);FX_NO_CONVERTER - $(DefineConstants);FX_NO_DEFAULT_DEPENDENCY_TYPE $(DefineConstants);FX_NO_CORHOST_SIGNER $(DefineConstants);FX_NO_EVENTWAITHANDLE_IDISPOSABLE $(DefineConstants);FX_NO_EXIT_CONTEXT_FLAGS - $(DefineConstants);FX_NO_LINKEDRESOURCES $(DefineConstants);FX_NO_PARAMETERIZED_THREAD_START $(DefineConstants);FX_NO_PDB_READER $(DefineConstants);FX_NO_PDB_WRITER - $(DefineConstants);FX_NO_REFLECTION_MODULE_HANDLES - $(DefineConstants);FX_NO_REFLECTION_ONLY - $(DefineConstants);FX_NO_RUNTIMEENVIRONMENT - $(DefineConstants);FX_NO_SECURITY_PERMISSIONS - $(DefineConstants);FX_NO_SERVERCODEPAGES $(DefineConstants);FX_NO_SYMBOLSTORE $(DefineConstants);FX_NO_SYSTEM_CONFIGURATION - $(DefineConstants);FX_NO_THREAD - $(DefineConstants);FX_NO_THREADABORT - $(DefineConstants);FX_NO_WAITONE_MILLISECONDS - $(DefineConstants);FX_NO_WEB_CLIENT $(DefineConstants);FX_NO_WIN_REGISTRY $(DefineConstants);FX_NO_WINFORMS $(DefineConstants);FX_NO_INDENTED_TEXT_WRITER - $(DefineConstants);FX_REDUCED_EXCEPTIONS $(DefineConstants);FX_RESHAPED_REFEMIT - $(DefineConstants);FX_RESHAPED_GLOBALIZATION - $(DefineConstants);FX_RESHAPED_REFLECTION $(DefineConstants);FX_RESHAPED_MSBUILD $(OtherFlags) --simpleresolution diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props index 6687fb4088..95fa8fcd02 100644 --- a/FSharpBuild.Directory.Build.props +++ b/FSharpBuild.Directory.Build.props @@ -94,6 +94,10 @@ true + + $(DefineConstants);TESTING_ON_LINUX + + $(ProtoOutputPath)\fsc\Microsoft.FSharp.Targets diff --git a/INTERNAL.md b/INTERNAL.md new file mode 100644 index 0000000000..b62e757de6 --- /dev/null +++ b/INTERNAL.md @@ -0,0 +1,60 @@ +# Links for internal team members to find build definitions, etc. + +Note that usually only the most recent link in each section is interesting. Older links are included for reference only. + +## PR Build Definition + +The PR build definition can be found [here](https://dev.azure.com/dnceng/public/_build?definitionId=496) or by +navigating through an existing PR. + +## Signed Build Definitions + +[VS 16.4 to current](https://dev.azure.com/dnceng/internal/_build?definitionId=499&_a=summary) + +[VS 15.7 to 16.3](https://dev.azure.com/devdiv/DevDiv/_build/index?definitionId=8978) + +[VS 15.6](https://dev.azure.com/devdiv/DevDiv/_build?definitionId=7239) + +[VS 15.0 to 15.5](https://dev.azure.com/devdiv/DevDiv/_build?definitionId=5037) + +## VS Insertion Generators + +VS 16.4 to current - part of the build definition. [See below](#vs-insertions-as-part-of-the-build-definition). + +The following insertion generators are automatically invoked upon successful completion of a signed build in each of +their respective branches. + +[VS 16.3](https://dev.azure.com/devdiv/DevDiv/_release?definitionId=1839&_a=releases) + +[VS 16.2](https://dev.azure.com/devdiv/DevDiv/_release?definitionId=1699&_a=releases) + +[VS 16.1](https://dev.azure.com/devdiv/DevDiv/_release?definitionId=1669&_a=releases) + +VS 16.0 and prior were done manually + +## VS Insertions as part of the build definition + +Starting with the 16.4 release and moving forwards, the VS insertion is generated as part of the build. The relevant +bits can be found near the bottom of [`azure-pipelines.yml`](azure-pipelines.yml) under the `VS Insertion` header. The +interesting parameters are `componentBranchName` and `insertTargetBranch`. In short, when an internal signed build +completes and the name of the branch built exactly equals the value in the `componentBranchName` parameter, a component +insertion into VS will be created into the `insertTargetBranch` branch. The link to the insertion PR will be found +near the bottom of the build under the title 'Insert into VS'. Examine the log for 'Insert VS Payload' and near the +bottom you'll see a line that looks like `Created request #xxxxxx at https://...`. + +To see all insertions created this way (possibly including for other internal teams), check +[here](https://dev.azure.com/devdiv/DevDiv/_git/VS/pullrequests?creatorId=122d5278-3e55-4868-9d40-1e28c2515fc4&_a=active). + +## Less interesting links + +[Nightly VSIX (master) uploader](https://dev.azure.com/dnceng/internal/_release?_a=releases&definitionId=70). Uploads +a package from every build of `master` to the [Nightly VSIX feed](README.md#using-nightly-releases-in-visual-studio). + +[Nightly VSIX (preview) uploader](https://dev.azure.com/dnceng/internal/_release?_a=releases&definitionId=71). Uploads +a package from every build of the branch that corresponds to the current Visual Studio preview to the +[Preview VSIX feed](README.md#using-nightly-releases-in-visual-studio). + +[MyGet package uploader](https://dev.azure.com/dnceng/internal/_release?_a=releases&definitionId=69). Uploads various +packages for internal consumption. Feed URL is `https://dotnet.myget.org/F/fsharp/api/v3/index.json`. + +[Internal source mirror](https://dev.azure.com/dnceng/internal/_git/dotnet-fsharp). diff --git a/NuGet.config b/NuGet.config index df85afb048..ef069a5bdf 100644 --- a/NuGet.config +++ b/NuGet.config @@ -18,10 +18,9 @@ - - + + - @@ -32,4 +31,7 @@ + + + diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 75f0178b7d..4d503dbeda 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -195,6 +195,7 @@ function BuildSolution() { /p:QuietRestore=$quietRestore ` /p:QuietRestoreBinaryLog=$binaryLog ` /p:TestTargetFrameworks=$testTargetFrameworks ` + /v:$verbosity ` $suppressExtensionDeployment ` @properties } @@ -337,6 +338,7 @@ try { if ($testDesktop -and -not $noVisualStudio) { TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj" -targetFramework $desktopTargetFramework + TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $desktopTargetFramework @@ -345,6 +347,7 @@ try { if ($testCoreClr) { TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj" -targetFramework $coreclrTargetFramework + TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $coreclrTargetFramework diff --git a/eng/Version.Details.xml b/eng/Version.Details.xml index 848ec45335..aef250643d 100644 --- a/eng/Version.Details.xml +++ b/eng/Version.Details.xml @@ -3,9 +3,9 @@ - + https://github.com/dotnet/arcade - e2f5f0f5c20a1fef71845795b09066a5cd892a7e + b449f372df1a3374ebdc85f42ff137dcda08776b diff --git a/eng/Versions.props b/eng/Versions.props index 4a8ca4fbc4..8efcedaa53 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -12,25 +12,25 @@ beta - 4.6 + 4.7 $(FSLanguageVersion) - $(FSCoreMajorVersion).3 + $(FSCoreMajorVersion).1 $(FSCoreMajorVersion).0 $(FSCoreVersionPrefix).0 - 4.6.2 + 4.7.0 $(FSCorePackageVersion)-$(PreReleaseVersionLabel).* - 10.5 + 10.6 $(FSPackageMajorVersion).0 $(FSPackageVersion) $(FSPackageVersion).0 16 - 2 + 3 $(VSMajorVersion).0 $(VSMajorVersion).$(VSMinorVersion).0 $(VSAssemblyVersionPrefix).0 @@ -55,15 +55,13 @@ https://dotnet.myget.org/F/roslyn-tools/api/v3/index.json; https://api.nuget.org/v3/index.json; https://dotnet.myget.org/F/roslyn/api/v3/index.json; - https://dotnet.myget.org/F/roslyn-analyzers/api/v3/index.json; https://dotnet.myget.org/F/symreader-converter/api/v3/index.json; https://dotnet.myget.org/F/interactive-window/api/v3/index.json; https://myget.org/F/vs-devcore/api/v3/index.json; https://myget.org/F/vs-editor/api/v3/index.json; - https://vside.myget.org/F/vssdk/api/v3/index.json; - https://vside.myget.org/F/vs-impl/api/v3/index.json; + https://pkgs.dev.azure.com/azure-public/vside/_packaging/vssdk/nuget/v3/index.json; + https://pkgs.dev.azure.com/azure-public/vside/_packaging/vs-impl/nuget/v3/index.json; https://myget.org/F/roslyn_concord/api/v3/index.json; - https://vside.myget.org/F/devcore/api/v3/index.json; $([System.IO.File]::ReadAllText('$(MSBuildThisFileDirectory)..\RoslynPackageVersion.txt').Trim()) @@ -116,6 +114,8 @@ 16.1.89 1.1.4322 16.1.89 + 16.1.89 + 16.0.28226-alpha 16.1.28916.169 16.1.28917.181 16.1.3121 @@ -125,6 +125,7 @@ 8.0.50728 7.10.6071 16.1.28917.181 + 16.1.89 8.0.50728 16.0.201-pre-g7d366164d0 2.3.6152103 @@ -141,7 +142,9 @@ 10.0.30320 11.0.61031 12.0.30111 + 16.0.0 16.1.89 + 16.1.89 7.10.6071 8.0.50728 10.0.30320 diff --git a/eng/build.sh b/eng/build.sh index e806856c55..81363af5db 100755 --- a/eng/build.sh +++ b/eng/build.sh @@ -178,7 +178,7 @@ function TestUsingNUnit() { args="test \"$testproject\" --no-restore --no-build -c $configuration -f $targetframework --test-adapter-path . --logger \"nunit;LogFilePath=$testlogpath\"" "$DOTNET_INSTALL_DIR/dotnet" $args || { local exit_code=$? - echo "dotnet test failed (exit code '$exit_code')." >&2 + Write-PipelineTelemetryError -category 'Test' "dotnet test failed for $testproject:$targetframework (exit code $exit_code)." ExitWithExitCode $exit_code } } @@ -228,7 +228,11 @@ function BuildSolution { MSBuild "$repo_root/src/buildtools/buildtools.proj" \ /restore \ /p:Configuration=$bootstrap_config \ - /t:Publish + /t:Publish || { + local exit_code=$? + Write-PipelineTelemetryError -category 'Build' "Error building buildtools (exit code '$exit_code')." + ExitWithExitCode $exit_code + } mkdir -p "$bootstrap_dir" cp -pr $artifacts_dir/bin/fslex/$bootstrap_config/netcoreapp2.1/publish $bootstrap_dir/fslex @@ -238,7 +242,11 @@ function BuildSolution { MSBuild "$repo_root/proto.proj" \ /restore \ /p:Configuration=$bootstrap_config \ - /t:Publish + /t:Publish || { + local exit_code=$? + Write-PipelineTelemetryError -category 'Build' "Error building bootstrap compiler (exit code '$exit_code')." + ExitWithExitCode $exit_code + } cp -pr $artifacts_dir/bin/fsc/$bootstrap_config/netcoreapp2.1/publish $bootstrap_dir/fsc fi @@ -246,6 +254,7 @@ function BuildSolution { # do real build MSBuild $toolset_build_proj \ $bl \ + /v:$verbosity \ /p:Configuration=$configuration \ /p:Projects="$projects" \ /p:RepoRoot="$repo_root" \ @@ -258,7 +267,11 @@ function BuildSolution { /p:ContinuousIntegrationBuild=$ci \ /p:QuietRestore=$quiet_restore \ /p:QuietRestoreBinaryLog="$binary_log" \ - $properties + $properties || { + local exit_code=$? + Write-PipelineTelemetryError -category 'Build' "Error building solution (exit code '$exit_code')." + ExitWithExitCode $exit_code + } } InitializeDotNetCli $restore @@ -272,8 +285,10 @@ if [[ "$test_core_clr" == true ]]; then coreclrtestframework=netcoreapp3.0 TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj" --targetframework $coreclrtestframework + TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj" --targetframework $coreclrtestframework fi ExitWithExitCode 0 + diff --git a/eng/common/build.ps1 b/eng/common/build.ps1 index feb58d1419..e001ccb481 100644 --- a/eng/common/build.ps1 +++ b/eng/common/build.ps1 @@ -85,6 +85,10 @@ function Build { # Re-assign properties to a new variable because PowerShell doesn't let us append properties directly for unclear reasons. # Explicitly set the type as string[] because otherwise PowerShell would make this char[] if $properties is empty. [string[]] $msbuildArgs = $properties + + # Resolve relative project paths into full paths + $projects = ($projects.Split(';').ForEach({Resolve-Path $_}) -join ';') + $msbuildArgs += "/p:Projects=$projects" $properties = $msbuildArgs } diff --git a/eng/common/darc-init.ps1 b/eng/common/darc-init.ps1 index 8854d979f3..46d175fdfd 100644 --- a/eng/common/darc-init.ps1 +++ b/eng/common/darc-init.ps1 @@ -1,9 +1,9 @@ param ( $darcVersion = $null, - $versionEndpoint = "https://maestro-prod.westus2.cloudapp.azure.com/api/assets/darc-version?api-version=2019-01-16" + $versionEndpoint = "https://maestro-prod.westus2.cloudapp.azure.com/api/assets/darc-version?api-version=2019-01-16", + $verbosity = "m" ) -$verbosity = "m" . $PSScriptRoot\tools.ps1 function InstallDarcCli ($darcVersion) { diff --git a/eng/common/darc-init.sh b/eng/common/darc-init.sh index abdd0bc05a..242429bca6 100755 --- a/eng/common/darc-init.sh +++ b/eng/common/darc-init.sh @@ -3,6 +3,7 @@ source="${BASH_SOURCE[0]}" darcVersion='' versionEndpoint="https://maestro-prod.westus2.cloudapp.azure.com/api/assets/darc-version?api-version=2019-01-16" +verbosity=m while [[ $# > 0 ]]; do opt="$(echo "$1" | awk '{print tolower($0)}')" @@ -15,6 +16,10 @@ while [[ $# > 0 ]]; do versionEndpoint=$2 shift ;; + --verbosity) + verbosity=$2 + shift + ;; *) echo "Invalid argument: $1" usage @@ -34,7 +39,6 @@ while [[ -h "$source" ]]; do [[ $source != /* ]] && source="$scriptroot/$source" done scriptroot="$( cd -P "$( dirname "$source" )" && pwd )" -verbosity=m . "$scriptroot/tools.sh" diff --git a/eng/common/enable-cross-org-publishing.ps1 b/eng/common/enable-cross-org-publishing.ps1 new file mode 100644 index 0000000000..eccbf9f1b1 --- /dev/null +++ b/eng/common/enable-cross-org-publishing.ps1 @@ -0,0 +1,6 @@ +param( + [string] $token +) + +Write-Host "##vso[task.setvariable variable=VSS_NUGET_ACCESSTOKEN]$token" +Write-Host "##vso[task.setvariable variable=VSS_NUGET_URI_PREFIXES]https://dnceng.pkgs.visualstudio.com/;https://pkgs.dev.azure.com/dnceng/;https://devdiv.pkgs.visualstudio.com/;https://pkgs.dev.azure.com/devdiv/" diff --git a/eng/common/init-tools-native.ps1 b/eng/common/init-tools-native.ps1 index 8cf18bcfeb..0fc0503ab9 100644 --- a/eng/common/init-tools-native.ps1 +++ b/eng/common/init-tools-native.ps1 @@ -133,6 +133,7 @@ try { if (Test-Path $InstallBin) { Write-Host "Native tools are available from" (Convert-Path -Path $InstallBin) Write-Host "##vso[task.prependpath]$(Convert-Path -Path $InstallBin)" + return $InstallBin } else { Write-Error "Native tools install directory does not exist, installation failed" diff --git a/eng/common/native/CommonLibrary.psm1 b/eng/common/native/CommonLibrary.psm1 index 2a08d5246e..41416862d9 100644 --- a/eng/common/native/CommonLibrary.psm1 +++ b/eng/common/native/CommonLibrary.psm1 @@ -152,6 +152,8 @@ function Get-File { } else { Write-Verbose "Downloading $Uri" + # Don't display the console progress UI - it's a huge perf hit + $ProgressPreference = 'SilentlyContinue' while($Attempt -Lt $DownloadRetries) { try { diff --git a/eng/common/performance/perfhelixpublish.proj b/eng/common/performance/perfhelixpublish.proj index 05e5f09891..e5826b5323 100644 --- a/eng/common/performance/perfhelixpublish.proj +++ b/eng/common/performance/perfhelixpublish.proj @@ -5,8 +5,14 @@ --dotnet-versions %DOTNET_VERSION% --cli-source-info args --cli-branch %PERFLAB_BRANCH% --cli-commit-sha %PERFLAB_HASH% --cli-repository https://github.com/%PERFLAB_REPO% --cli-source-timestamp %PERFLAB_BUILDTIMESTAMP% py -3 %HELIX_CORRELATION_PAYLOAD%\Core_Root\CoreRun.exe + %HELIX_CORRELATION_PAYLOAD%\Baseline_Core_Root\CoreRun.exe $(HelixPreCommands);call %HELIX_CORRELATION_PAYLOAD%\performance\tools\machine-setup.cmd %HELIX_CORRELATION_PAYLOAD%\artifacts\BenchmarkDotNet.Artifacts + %HELIX_CORRELATION_PAYLOAD%\artifacts\BenchmarkDotNet.Artifacts_Baseline + %HELIX_CORRELATION_PAYLOAD%\performance\src\tools\ResultsComparer\ResultsComparer.csproj + %HELIX_CORRELATION_PAYLOAD%\performance\tools\dotnet\$(Architecture)\dotnet.exe + %25%25 + %HELIX_WORKITEM_ROOT%\testResults.xml @@ -24,14 +30,24 @@ --dotnet-versions $DOTNET_VERSION --cli-source-info args --cli-branch $PERFLAB_BRANCH --cli-commit-sha $PERFLAB_HASH --cli-repository https://github.com/$PERFLAB_REPO --cli-source-timestamp $PERFLAB_BUILDTIMESTAMP python3 $(BaseDirectory)/Core_Root/corerun + $(BaseDirectory)/Baseline_Core_Root/corerun $(HelixPreCommands);chmod +x $(PerformanceDirectory)/tools/machine-setup.sh;. $(PerformanceDirectory)/tools/machine-setup.sh $(BaseDirectory)/artifacts/BenchmarkDotNet.Artifacts + $(BaseDirectory)/artifacts/BenchmarkDotNet.Artifacts_Baseline + $(PerformanceDirectory)/src/tools/ResultsComparer/ResultsComparer.csproj + $(PerformanceDirectory)/tools/dotnet/$(Architecture)/dotnet + %25 + $HELIX_WORKITEM_ROOT/testResults.xml --corerun $(CoreRun) + + --corerun $(BaselineCoreRun) + + $(Python) $(WorkItemCommand) --incremental no --architecture $(Architecture) -f $(_Framework) $(PerfLabArguments) @@ -57,20 +73,29 @@ + + false + + $(WorkItemDirectory) - $(WorkItemCommand) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(CoreRunArgument) --artifacts $(ArtifactsDirectory) --partition-count $(PartitionCount) --partition-index %(HelixWorkItem.Index)" + $(WorkItemCommand) --bdn-artifacts $(BaselineArtifactsDirectory) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(BaselineCoreRunArgument) --partition-count $(PartitionCount) --partition-index %(HelixWorkItem.Index)" + $(WorkItemCommand) --bdn-artifacts $(ArtifactsDirectory) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(CoreRunArgument) --partition-count $(PartitionCount) --partition-index %(HelixWorkItem.Index)" + $(DotnetExe) run -f $(_Framework) -p $(ResultsComparer) --base $(BaselineArtifactsDirectory) --diff $(ArtifactsDirectory) --threshold 2$(Percent) --xml $(XMLResults);$(FinalCommand) 4:00 + $(WorkItemDirectory) - $(WorkItemCommand) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(CoreRunArgument) --artifacts $(ArtifactsDirectory)" + $(WorkItemCommand) --bdn-artifacts $(BaselineArtifactsDirectory) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(BaselineCoreRunArgument)" + $(WorkItemCommand) --bdn-artifacts $(ArtifactsDirectory) --bdn-arguments="--anyCategories $(BDNCategories) $(ExtraBenchmarkDotNetArguments) $(CoreRunArgument)" + $(DotnetExe) run -f $(_Framework) -p $(ResultsComparer) --base $(BaselineArtifactsDirectory) --diff $(ArtifactsDirectory) --threshold 2$(Percent) --xml $(XMLResults) 4:00 diff --git a/eng/common/performance/performance-setup.ps1 b/eng/common/performance/performance-setup.ps1 index 7e5441f797..ec41965fc8 100644 --- a/eng/common/performance/performance-setup.ps1 +++ b/eng/common/performance/performance-setup.ps1 @@ -1,8 +1,9 @@ Param( [string] $SourceDirectory=$env:BUILD_SOURCESDIRECTORY, [string] $CoreRootDirectory, + [string] $BaselineCoreRootDirectory, [string] $Architecture="x64", - [string] $Framework="netcoreapp3.0", + [string] $Framework="netcoreapp5.0", [string] $CompilationMode="Tiered", [string] $Repository=$env:BUILD_REPOSITORY_NAME, [string] $Branch=$env:BUILD_SOURCEBRANCH, @@ -12,11 +13,13 @@ Param( [string] $Csproj="src\benchmarks\micro\MicroBenchmarks.csproj", [string] $Kind="micro", [switch] $Internal, + [switch] $Compare, [string] $Configurations="CompilationMode=$CompilationMode" ) -$RunFromPerformanceRepo = ($Repository -eq "dotnet/performance") +$RunFromPerformanceRepo = ($Repository -eq "dotnet/performance") -or ($Repository -eq "dotnet-performance") $UseCoreRun = ($CoreRootDirectory -ne [string]::Empty) +$UseBaselineCoreRun = ($BaselineCoreRootDirectory -ne [string]::Empty) $PayloadDirectory = (Join-Path $SourceDirectory "Payload") $PerformanceDirectory = (Join-Path $PayloadDirectory "performance") @@ -29,11 +32,17 @@ $HelixSourcePrefix = "pr" $Queue = "Windows.10.Amd64.ClientRS4.DevEx.15.8.Open" if ($Framework.StartsWith("netcoreapp")) { - $Queue = "Windows.10.Amd64.ClientRS4.Open" + $Queue = "Windows.10.Amd64.ClientRS5.Open" +} + +if ($Compare) { + $Queue = "Windows.10.Amd64.19H1.Tiger.Perf.Open" + $PerfLabArguments = "" + $ExtraBenchmarkDotNetArguments = "" } if ($Internal) { - $Queue = "Windows.10.Amd64.ClientRS5.Perf" + $Queue = "Windows.10.Amd64.19H1.Tiger.Perf" $PerfLabArguments = "--upload-to-perflab-container" $ExtraBenchmarkDotNetArguments = "" $Creator = "" @@ -56,6 +65,10 @@ if ($UseCoreRun) { $NewCoreRoot = (Join-Path $PayloadDirectory "Core_Root") Move-Item -Path $CoreRootDirectory -Destination $NewCoreRoot } +if ($UseBaselineCoreRun) { + $NewBaselineCoreRoot = (Join-Path $PayloadDirectory "Baseline_Core_Root") + Move-Item -Path $BaselineCoreRootDirectory -Destination $NewBaselineCoreRoot +} $DocsDir = (Join-Path $PerformanceDirectory "docs") robocopy $DocsDir $WorkItemDirectory @@ -80,7 +93,9 @@ Write-PipelineSetVariable -Name 'TargetCsproj' -Value "$Csproj" -IsMultiJobVaria Write-PipelineSetVariable -Name 'Kind' -Value "$Kind" -IsMultiJobVariable $false Write-PipelineSetVariable -Name 'Architecture' -Value "$Architecture" -IsMultiJobVariable $false Write-PipelineSetVariable -Name 'UseCoreRun' -Value "$UseCoreRun" -IsMultiJobVariable $false +Write-PipelineSetVariable -Name 'UseBaselineCoreRun' -Value "$UseBaselineCoreRun" -IsMultiJobVariable $false Write-PipelineSetVariable -Name 'RunFromPerfRepo' -Value "$RunFromPerformanceRepo" -IsMultiJobVariable $false +Write-PipelineSetVariable -Name 'Compare' -Value "$Compare" -IsMultiJobVariable $false # Helix Arguments Write-PipelineSetVariable -Name 'Creator' -Value "$Creator" -IsMultiJobVariable $false diff --git a/eng/common/performance/performance-setup.sh b/eng/common/performance/performance-setup.sh index 126da5f76d..2f2092166e 100755 --- a/eng/common/performance/performance-setup.sh +++ b/eng/common/performance/performance-setup.sh @@ -2,20 +2,23 @@ source_directory=$BUILD_SOURCESDIRECTORY core_root_directory= +baseline_core_root_directory= architecture=x64 -framework=netcoreapp3.0 +framework=netcoreapp5.0 compilation_mode=tiered repository=$BUILD_REPOSITORY_NAME branch=$BUILD_SOURCEBRANCH commit_sha=$BUILD_SOURCEVERSION build_number=$BUILD_BUILDNUMBER internal=false +compare=false kind="micro" run_categories="coreclr corefx" csproj="src\benchmarks\micro\MicroBenchmarks.csproj" configurations= run_from_perf_repo=false use_core_run=true +use_baseline_core_run=true while (($# > 0)); do lowerI="$(echo $1 | awk '{print tolower($0)}')" @@ -28,6 +31,10 @@ while (($# > 0)); do core_root_directory=$2 shift 2 ;; + --baselinecorerootdirectory) + baseline_core_root_directory=$2 + shift 2 + ;; --architecture) architecture=$2 shift 2 @@ -72,6 +79,10 @@ while (($# > 0)); do internal=true shift 1 ;; + --compare) + compare=true + shift 1 + ;; --configurations) configurations=$2 shift 2 @@ -102,7 +113,7 @@ while (($# > 0)); do esac done -if [[ "$repository" == "dotnet/performance" ]]; then +if [ "$repository" == "dotnet/performance" ] || [ "$repository" == "dotnet-performance" ]; then run_from_perf_repo=true fi @@ -114,6 +125,10 @@ if [ -z "$core_root_directory" ]; then use_core_run=false fi +if [ -z "$baseline_core_root_directory" ]; then + use_baseline_core_run=false +fi + payload_directory=$source_directory/Payload performance_directory=$payload_directory/performance workitem_directory=$source_directory/workitem @@ -123,6 +138,19 @@ queue=Ubuntu.1804.Amd64.Open creator=$BUILD_DEFINITIONNAME helix_source_prefix="pr" +if [[ "$compare" == true ]]; then + extra_benchmark_dotnet_arguments= + perflab_arguments= + + # No open queues for arm64 + if [[ "$architecture" = "arm64" ]]; then + echo "Compare not available for arm64" + exit 1 + fi + + queue=Ubuntu.1804.Amd64.Tiger.Perf.Open +fi + if [[ "$internal" == true ]]; then perflab_arguments="--upload-to-perflab-container" helix_source_prefix="official" @@ -132,7 +160,7 @@ if [[ "$internal" == true ]]; then if [[ "$architecture" = "arm64" ]]; then queue=Ubuntu.1804.Arm64.Perf else - queue=Ubuntu.1804.Amd64.Perf + queue=Ubuntu.1804.Amd64.Tiger.Perf fi fi @@ -156,21 +184,33 @@ if [[ "$use_core_run" = true ]]; then mv $core_root_directory $new_core_root fi +if [[ "$use_baseline_core_run" = true ]]; then + new_baseline_core_root=$payload_directory/Baseline_Core_Root + mv $baseline_core_root_directory $new_baseline_core_root +fi + +ci=true + +_script_dir=$(pwd)/eng/common +. "$_script_dir/pipeline-logging-functions.sh" + # Make sure all of our variables are available for future steps -echo "##vso[task.setvariable variable=UseCoreRun]$use_core_run" -echo "##vso[task.setvariable variable=Architecture]$architecture" -echo "##vso[task.setvariable variable=PayloadDirectory]$payload_directory" -echo "##vso[task.setvariable variable=PerformanceDirectory]$performance_directory" -echo "##vso[task.setvariable variable=WorkItemDirectory]$workitem_directory" -echo "##vso[task.setvariable variable=Queue]$queue" -echo "##vso[task.setvariable variable=SetupArguments]$setup_arguments" -echo "##vso[task.setvariable variable=Python]python3" -echo "##vso[task.setvariable variable=PerfLabArguments]$perflab_arguments" -echo "##vso[task.setvariable variable=ExtraBenchmarkDotNetArguments]$extra_benchmark_dotnet_arguments" -echo "##vso[task.setvariable variable=BDNCategories]$run_categories" -echo "##vso[task.setvariable variable=TargetCsproj]$csproj" -echo "##vso[task.setvariable variable=RunFromPerfRepo]$run_from_perf_repo" -echo "##vso[task.setvariable variable=Creator]$creator" -echo "##vso[task.setvariable variable=HelixSourcePrefix]$helix_source_prefix" -echo "##vso[task.setvariable variable=Kind]$kind" -echo "##vso[task.setvariable variable=_BuildConfig]$architecture.$kind.$framework" \ No newline at end of file +Write-PipelineSetVariable -name "UseCoreRun" -value "$use_core_run" -is_multi_job_variable false +Write-PipelineSetVariable -name "UseBaselineCoreRun" -value "$use_baseline_core_run" -is_multi_job_variable false +Write-PipelineSetVariable -name "Architecture" -value "$architecture" -is_multi_job_variable false +Write-PipelineSetVariable -name "PayloadDirectory" -value "$payload_directory" -is_multi_job_variable false +Write-PipelineSetVariable -name "PerformanceDirectory" -value "$performance_directory" -is_multi_job_variable false +Write-PipelineSetVariable -name "WorkItemDirectory" -value "$workitem_directory" -is_multi_job_variable false +Write-PipelineSetVariable -name "Queue" -value "$queue" -is_multi_job_variable false +Write-PipelineSetVariable -name "SetupArguments" -value "$setup_arguments" -is_multi_job_variable false +Write-PipelineSetVariable -name "Python" -value "$python3" -is_multi_job_variable false +Write-PipelineSetVariable -name "PerfLabArguments" -value "$perflab_arguments" -is_multi_job_variable false +Write-PipelineSetVariable -name "ExtraBenchmarkDotNetArguments" -value "$extra_benchmark_dotnet_arguments" -is_multi_job_variable false +Write-PipelineSetVariable -name "BDNCategories" -value "$run_categories" -is_multi_job_variable false +Write-PipelineSetVariable -name "TargetCsproj" -value "$csproj" -is_multi_job_variable false +Write-PipelineSetVariable -name "RunFromPerfRepo" -value "$run_from_perf_repo" -is_multi_job_variable false +Write-PipelineSetVariable -name "Creator" -value "$creator" -is_multi_job_variable false +Write-PipelineSetVariable -name "HelixSourcePrefix" -value "$helix_source_prefix" -is_multi_job_variable false +Write-PipelineSetVariable -name "Kind" -value "$kind" -is_multi_job_variable false +Write-PipelineSetVariable -name "_BuildConfig" -value "$architecture.$kind.$framework" -is_multi_job_variable false +Write-PipelineSetVariable -name "Compare" -value "$compare" -is_multi_job_variable false diff --git a/eng/common/post-build/darc-gather-drop.ps1 b/eng/common/post-build/darc-gather-drop.ps1 index 93a0bd8328..89854d3c1c 100644 --- a/eng/common/post-build/darc-gather-drop.ps1 +++ b/eng/common/post-build/darc-gather-drop.ps1 @@ -19,7 +19,17 @@ try { ExitWithExitCode $exitCode } + # For now, only use a dry run. + # Ideally we would change darc to enable a quick request that + # would check whether the file exists that you can download it, + # and that it won't conflict with other files. + # https://github.com/dotnet/arcade/issues/3674 + # Right now we can't remove continue-on-error because we ocassionally will have + # dependencies that have no associated builds (e.g. an old dependency). + # We need to add an option to baseline specific dependencies away, or add them manually + # to the BAR. darc gather-drop --non-shipping ` + --dry-run ` --continue-on-error ` --id $BarBuildId ` --output-dir $DropLocation ` diff --git a/eng/common/post-build/sourcelink-validation.ps1 b/eng/common/post-build/sourcelink-validation.ps1 index 41e01ae6e6..bbfdacca13 100644 --- a/eng/common/post-build/sourcelink-validation.ps1 +++ b/eng/common/post-build/sourcelink-validation.ps1 @@ -1,8 +1,8 @@ param( [Parameter(Mandatory=$true)][string] $InputPath, # Full path to directory where Symbols.NuGet packages to be checked are stored [Parameter(Mandatory=$true)][string] $ExtractPath, # Full path to directory where the packages will be extracted during validation - [Parameter(Mandatory=$true)][string] $GHRepoName, # GitHub name of the repo including the Org. E.g., dotnet/arcade - [Parameter(Mandatory=$true)][string] $GHCommit, # GitHub commit SHA used to build the packages + [Parameter(Mandatory=$false)][string] $GHRepoName, # GitHub name of the repo including the Org. E.g., dotnet/arcade + [Parameter(Mandatory=$false)][string] $GHCommit, # GitHub commit SHA used to build the packages [Parameter(Mandatory=$true)][string] $SourcelinkCliVersion # Version of SourceLink CLI to use ) @@ -13,6 +13,12 @@ param( # all files present in the repo at a specific commit point. $global:RepoFiles = @{} +# Maximum number of jobs to run in parallel +$MaxParallelJobs = 6 + +# Wait time between check for system load +$SecondsBetweenLoadChecks = 10 + $ValidatePackage = { param( [string] $PackagePath # Full path to a Symbols.NuGet package @@ -22,8 +28,8 @@ $ValidatePackage = { # Ensure input file exist if (!(Test-Path $PackagePath)) { - Write-PipelineTaskError "Input file does not exist: $PackagePath" - ExitWithExitCode 1 + Write-Host "Input file does not exist: $PackagePath" + return 1 } # Extensions for which we'll look for SourceLink information @@ -38,7 +44,7 @@ $ValidatePackage = { Add-Type -AssemblyName System.IO.Compression.FileSystem - [System.IO.Directory]::CreateDirectory($ExtractPath); + [System.IO.Directory]::CreateDirectory($ExtractPath) | Out-Null try { $zip = [System.IO.Compression.ZipFile]::OpenRead($PackagePath) @@ -138,16 +144,18 @@ $ValidatePackage = { if ($FailedFiles -eq 0) { Write-Host "Passed." + return 0 } else { - Write-PipelineTaskError "$PackagePath has broken SourceLink links." + Write-Host "$PackagePath has broken SourceLink links." + return 1 } } function ValidateSourceLinkLinks { - if (!($GHRepoName -Match "^[^\s\/]+/[^\s\/]+$")) { + if ($GHRepoName -ne "" -and !($GHRepoName -Match "^[^\s\/]+/[^\s\/]+$")) { if (!($GHRepoName -Match "^[^\s-]+-[^\s]+$")) { - Write-PipelineTaskError "GHRepoName should be in the format / or -" + Write-PipelineTaskError "GHRepoName should be in the format / or -. '$GHRepoName'" ExitWithExitCode 1 } else { @@ -155,30 +163,33 @@ function ValidateSourceLinkLinks { } } - if (!($GHCommit -Match "^[0-9a-fA-F]{40}$")) { - Write-PipelineTaskError "GHCommit should be a 40 chars hexadecimal string" + if ($GHCommit -ne "" -and !($GHCommit -Match "^[0-9a-fA-F]{40}$")) { + Write-PipelineTaskError "GHCommit should be a 40 chars hexadecimal string. '$GHCommit'" ExitWithExitCode 1 } - $RepoTreeURL = -Join("http://api.github.com/repos/", $GHRepoName, "/git/trees/", $GHCommit, "?recursive=1") - $CodeExtensions = @(".cs", ".vb", ".fs", ".fsi", ".fsx", ".fsscript") + if ($GHRepoName -ne "" -and $GHCommit -ne "") { + $RepoTreeURL = -Join("http://api.github.com/repos/", $GHRepoName, "/git/trees/", $GHCommit, "?recursive=1") + $CodeExtensions = @(".cs", ".vb", ".fs", ".fsi", ".fsx", ".fsscript") - try { - # Retrieve the list of files in the repo at that particular commit point and store them in the RepoFiles hash - $Data = Invoke-WebRequest $RepoTreeURL -UseBasicParsing | ConvertFrom-Json | Select-Object -ExpandProperty tree + try { + # Retrieve the list of files in the repo at that particular commit point and store them in the RepoFiles hash + $Data = Invoke-WebRequest $RepoTreeURL -UseBasicParsing | ConvertFrom-Json | Select-Object -ExpandProperty tree - foreach ($file in $Data) { - $Extension = [System.IO.Path]::GetExtension($file.path) + foreach ($file in $Data) { + $Extension = [System.IO.Path]::GetExtension($file.path) - if ($CodeExtensions.Contains($Extension)) { - $RepoFiles[$file.path] = 1 + if ($CodeExtensions.Contains($Extension)) { + $RepoFiles[$file.path] = 1 + } } } + catch { + Write-Host "Problems downloading the list of files from the repo. Url used: $RepoTreeURL . Execution will proceed without caching." + } } - catch { - Write-PipelineTaskError "Problems downloading the list of files from the repo. Url used: $RepoTreeURL" - Write-Host $_ - ExitWithExitCode 1 + elseif ($GHRepoName -ne "" -or $GHCommit -ne "") { + Write-Host "For using the http caching mechanism both GHRepoName and GHCommit should be informed." } if (Test-Path $ExtractPath) { @@ -186,14 +197,33 @@ function ValidateSourceLinkLinks { } # Process each NuGet package in parallel - $Jobs = @() Get-ChildItem "$InputPath\*.symbols.nupkg" | ForEach-Object { - $Jobs += Start-Job -ScriptBlock $ValidatePackage -ArgumentList $_.FullName + Start-Job -ScriptBlock $ValidatePackage -ArgumentList $_.FullName | Out-Null + $NumJobs = @(Get-Job -State 'Running').Count + + while ($NumJobs -ge $MaxParallelJobs) { + Write-Host "There are $NumJobs validation jobs running right now. Waiting $SecondsBetweenLoadChecks seconds to check again." + sleep $SecondsBetweenLoadChecks + $NumJobs = @(Get-Job -State 'Running').Count + } + + foreach ($Job in @(Get-Job -State 'Completed')) { + Receive-Job -Id $Job.Id + Remove-Job -Id $Job.Id + } } - foreach ($Job in $Jobs) { - Wait-Job -Id $Job.Id | Receive-Job + $ValidationFailures = 0 + foreach ($Job in @(Get-Job)) { + $jobResult = Wait-Job -Id $Job.Id | Receive-Job + if ($jobResult -ne "0") { + $ValidationFailures++ + } + } + if ($ValidationFailures -gt 0) { + Write-PipelineTaskError " $ValidationFailures package(s) failed validation." + ExitWithExitCode 1 } } diff --git a/eng/common/post-build/symbols-validation.ps1 b/eng/common/post-build/symbols-validation.ps1 index d5ec51b150..42f5e996bc 100644 --- a/eng/common/post-build/symbols-validation.ps1 +++ b/eng/common/post-build/symbols-validation.ps1 @@ -37,10 +37,10 @@ function FirstMatchingSymbolDescriptionOrDefault { # DWARF file for a .dylib $DylibDwarf = $SymbolPath.Replace($Extension, ".dylib.dwarf") - $dotnetsymbolExe = "$env:USERPROFILE\.dotnet\tools" - $dotnetsymbolExe = Resolve-Path "$dotnetsymbolExe\dotnet-symbol.exe" + $dotnetSymbolExe = "$env:USERPROFILE\.dotnet\tools" + $dotnetSymbolExe = Resolve-Path "$dotnetSymbolExe\dotnet-symbol.exe" - & $dotnetsymbolExe --symbols --modules --windows-pdbs $TargetServerParam $FullPath -o $SymbolsPath | Out-Null + & $dotnetSymbolExe --symbols --modules --windows-pdbs $TargetServerParam $FullPath -o $SymbolsPath | Out-Null if (Test-Path $PdbPath) { return "PDB" @@ -159,26 +159,25 @@ function CheckSymbolsAvailable { } } -function Installdotnetsymbol { - $dotnetsymbolPackageName = "dotnet-symbol" +function InstallDotnetSymbol { + $dotnetSymbolPackageName = "dotnet-symbol" $dotnetRoot = InitializeDotNetCli -install:$true $dotnet = "$dotnetRoot\dotnet.exe" $toolList = & "$dotnet" tool list --global - if (($toolList -like "*$dotnetsymbolPackageName*") -and ($toolList -like "*$dotnetsymbolVersion*")) { - Write-Host "dotnet-symbol version $dotnetsymbolVersion is already installed." + if (($toolList -like "*$dotnetSymbolPackageName*") -and ($toolList -like "*$dotnetSymbolVersion*")) { + Write-Host "dotnet-symbol version $dotnetSymbolVersion is already installed." } else { - Write-Host "Installing dotnet-symbol version $dotnetsymbolVersion..." + Write-Host "Installing dotnet-symbol version $dotnetSymbolVersion..." Write-Host "You may need to restart your command window if this is the first dotnet tool you have installed." - & "$dotnet" tool install $dotnetsymbolPackageName --version $dotnetsymbolVersion --verbosity "minimal" --global + & "$dotnet" tool install $dotnetSymbolPackageName --version $dotnetSymbolVersion --verbosity "minimal" --global } } try { - Installdotnetsymbol - + InstallDotnetSymbol CheckSymbolsAvailable } catch { diff --git a/eng/common/sdl/execute-all-sdl-tools.ps1 b/eng/common/sdl/execute-all-sdl-tools.ps1 index aab7589f2c..eb21321ba2 100644 --- a/eng/common/sdl/execute-all-sdl-tools.ps1 +++ b/eng/common/sdl/execute-all-sdl-tools.ps1 @@ -1,30 +1,30 @@ Param( - [string] $GuardianPackageName, # Required: the name of guardian CLI package (not needed if GuardianCliLocation is specified) - [string] $NugetPackageDirectory, # Required: directory where NuGet packages are installed (not needed if GuardianCliLocation is specified) - [string] $GuardianCliLocation, # Optional: Direct location of Guardian CLI executable if GuardianPackageName & NugetPackageDirectory are not specified - [string] $Repository=$env:BUILD_REPOSITORY_NAME, # Required: the name of the repository (e.g. dotnet/arcade) - [string] $BranchName=$env:BUILD_SOURCEBRANCH, # Optional: name of branch or version of gdn settings; defaults to master - [string] $SourceDirectory=$env:BUILD_SOURCESDIRECTORY, # Required: the directory where source files are located - [string] $ArtifactsDirectory = (Join-Path $env:BUILD_SOURCESDIRECTORY ("artifacts")), # Required: the directory where build artifacts are located - [string] $AzureDevOpsAccessToken, # Required: access token for dnceng; should be provided via KeyVault - [string[]] $SourceToolsList, # Optional: list of SDL tools to run on source code - [string[]] $ArtifactToolsList, # Optional: list of SDL tools to run on built artifacts - [bool] $TsaPublish=$False, # Optional: true will publish results to TSA; only set to true after onboarding to TSA; TSA is the automated framework used to upload test results as bugs. - [string] $TsaBranchName=$env:BUILD_SOURCEBRANCH, # Optional: required for TSA publish; defaults to $(Build.SourceBranchName); TSA is the automated framework used to upload test results as bugs. - [string] $TsaRepositoryName=$env:BUILD_REPOSITORY_NAME, # Optional: TSA repository name; will be generated automatically if not submitted; TSA is the automated framework used to upload test results as bugs. - [string] $BuildNumber=$env:BUILD_BUILDNUMBER, # Optional: required for TSA publish; defaults to $(Build.BuildNumber) - [bool] $UpdateBaseline=$False, # Optional: if true, will update the baseline in the repository; should only be run after fixing any issues which need to be fixed - [bool] $TsaOnboard=$False, # Optional: if true, will onboard the repository to TSA; should only be run once; TSA is the automated framework used to upload test results as bugs. - [string] $TsaInstanceUrl, # Optional: only needed if TsaOnboard or TsaPublish is true; the instance-url registered with TSA; TSA is the automated framework used to upload test results as bugs. - [string] $TsaCodebaseName, # Optional: only needed if TsaOnboard or TsaPublish is true; the name of the codebase registered with TSA; TSA is the automated framework used to upload test results as bugs. - [string] $TsaProjectName, # Optional: only needed if TsaOnboard or TsaPublish is true; the name of the project registered with TSA; TSA is the automated framework used to upload test results as bugs. - [string] $TsaNotificationEmail, # Optional: only needed if TsaOnboard is true; the email(s) which will receive notifications of TSA bug filings (e.g. alias@microsoft.com); TSA is the automated framework used to upload test results as bugs. - [string] $TsaCodebaseAdmin, # Optional: only needed if TsaOnboard is true; the aliases which are admins of the TSA codebase (e.g. DOMAIN\alias); TSA is the automated framework used to upload test results as bugs. - [string] $TsaBugAreaPath, # Optional: only needed if TsaOnboard is true; the area path where TSA will file bugs in AzDO; TSA is the automated framework used to upload test results as bugs. - [string] $TsaIterationPath, # Optional: only needed if TsaOnboard is true; the iteration path where TSA will file bugs in AzDO; TSA is the automated framework used to upload test results as bugs. - [string] $GuardianLoggerLevel="Standard", # Optional: the logger level for the Guardian CLI; options are Trace, Verbose, Standard, Warning, and Error - [string[]] $CrScanAdditionalRunConfigParams, # Optional: Additional Params to custom build a CredScan run config in the format @("xyz:abc","sdf:1") - [string[]] $PoliCheckAdditionalRunConfigParams # Optional: Additional Params to custom build a Policheck run config in the format @("xyz:abc","sdf:1") + [string] $GuardianPackageName, # Required: the name of guardian CLI package (not needed if GuardianCliLocation is specified) + [string] $NugetPackageDirectory, # Required: directory where NuGet packages are installed (not needed if GuardianCliLocation is specified) + [string] $GuardianCliLocation, # Optional: Direct location of Guardian CLI executable if GuardianPackageName & NugetPackageDirectory are not specified + [string] $Repository=$env:BUILD_REPOSITORY_NAME, # Required: the name of the repository (e.g. dotnet/arcade) + [string] $BranchName=$env:BUILD_SOURCEBRANCH, # Optional: name of branch or version of gdn settings; defaults to master + [string] $SourceDirectory=$env:BUILD_SOURCESDIRECTORY, # Required: the directory where source files are located + [string] $ArtifactsDirectory = (Join-Path $env:BUILD_ARTIFACTSTAGINGDIRECTORY ("artifacts")), # Required: the directory where build artifacts are located + [string] $AzureDevOpsAccessToken, # Required: access token for dnceng; should be provided via KeyVault + [string[]] $SourceToolsList, # Optional: list of SDL tools to run on source code + [string[]] $ArtifactToolsList, # Optional: list of SDL tools to run on built artifacts + [bool] $TsaPublish=$False, # Optional: true will publish results to TSA; only set to true after onboarding to TSA; TSA is the automated framework used to upload test results as bugs. + [string] $TsaBranchName=$env:BUILD_SOURCEBRANCH, # Optional: required for TSA publish; defaults to $(Build.SourceBranchName); TSA is the automated framework used to upload test results as bugs. + [string] $TsaRepositoryName=$env:BUILD_REPOSITORY_NAME, # Optional: TSA repository name; will be generated automatically if not submitted; TSA is the automated framework used to upload test results as bugs. + [string] $BuildNumber=$env:BUILD_BUILDNUMBER, # Optional: required for TSA publish; defaults to $(Build.BuildNumber) + [bool] $UpdateBaseline=$False, # Optional: if true, will update the baseline in the repository; should only be run after fixing any issues which need to be fixed + [bool] $TsaOnboard=$False, # Optional: if true, will onboard the repository to TSA; should only be run once; TSA is the automated framework used to upload test results as bugs. + [string] $TsaInstanceUrl, # Optional: only needed if TsaOnboard or TsaPublish is true; the instance-url registered with TSA; TSA is the automated framework used to upload test results as bugs. + [string] $TsaCodebaseName, # Optional: only needed if TsaOnboard or TsaPublish is true; the name of the codebase registered with TSA; TSA is the automated framework used to upload test results as bugs. + [string] $TsaProjectName, # Optional: only needed if TsaOnboard or TsaPublish is true; the name of the project registered with TSA; TSA is the automated framework used to upload test results as bugs. + [string] $TsaNotificationEmail, # Optional: only needed if TsaOnboard is true; the email(s) which will receive notifications of TSA bug filings (e.g. alias@microsoft.com); TSA is the automated framework used to upload test results as bugs. + [string] $TsaCodebaseAdmin, # Optional: only needed if TsaOnboard is true; the aliases which are admins of the TSA codebase (e.g. DOMAIN\alias); TSA is the automated framework used to upload test results as bugs. + [string] $TsaBugAreaPath, # Optional: only needed if TsaOnboard is true; the area path where TSA will file bugs in AzDO; TSA is the automated framework used to upload test results as bugs. + [string] $TsaIterationPath, # Optional: only needed if TsaOnboard is true; the iteration path where TSA will file bugs in AzDO; TSA is the automated framework used to upload test results as bugs. + [string] $GuardianLoggerLevel="Standard", # Optional: the logger level for the Guardian CLI; options are Trace, Verbose, Standard, Warning, and Error + [string[]] $CrScanAdditionalRunConfigParams, # Optional: Additional Params to custom build a CredScan run config in the format @("xyz:abc","sdf:1") + [string[]] $PoliCheckAdditionalRunConfigParams # Optional: Additional Params to custom build a Policheck run config in the format @("xyz:abc","sdf:1") ) $ErrorActionPreference = "Stop" @@ -45,6 +45,7 @@ if ($GuardianPackageName) { $guardianCliLocation = $GuardianCliLocation } +$workingDirectory = (Split-Path $SourceDirectory -Parent) $ValidPath = Test-Path $guardianCliLocation if ($ValidPath -eq $False) @@ -53,13 +54,13 @@ if ($ValidPath -eq $False) exit 1 } -& $(Join-Path $PSScriptRoot "init-sdl.ps1") -GuardianCliLocation $guardianCliLocation -Repository $RepoName -BranchName $BranchName -WorkingDirectory $ArtifactsDirectory -AzureDevOpsAccessToken $AzureDevOpsAccessToken -GuardianLoggerLevel $GuardianLoggerLevel -$gdnFolder = Join-Path $ArtifactsDirectory ".gdn" +& $(Join-Path $PSScriptRoot "init-sdl.ps1") -GuardianCliLocation $guardianCliLocation -Repository $RepoName -BranchName $BranchName -WorkingDirectory $workingDirectory -AzureDevOpsAccessToken $AzureDevOpsAccessToken -GuardianLoggerLevel $GuardianLoggerLevel +$gdnFolder = Join-Path $workingDirectory ".gdn" if ($TsaOnboard) { if ($TsaCodebaseName -and $TsaNotificationEmail -and $TsaCodebaseAdmin -and $TsaBugAreaPath) { - Write-Host "$guardianCliLocation tsa-onboard --codebase-name `"$TsaCodebaseName`" --notification-alias `"$TsaNotificationEmail`" --codebase-admin `"$TsaCodebaseAdmin`" --instance-url `"$TsaInstanceUrl`" --project-name `"$TsaProjectName`" --area-path `"$TsaBugAreaPath`" --iteration-path `"$TsaIterationPath`" --working-directory $ArtifactsDirectory --logger-level $GuardianLoggerLevel" - & $guardianCliLocation tsa-onboard --codebase-name "$TsaCodebaseName" --notification-alias "$TsaNotificationEmail" --codebase-admin "$TsaCodebaseAdmin" --instance-url "$TsaInstanceUrl" --project-name "$TsaProjectName" --area-path "$TsaBugAreaPath" --iteration-path "$TsaIterationPath" --working-directory $ArtifactsDirectory --logger-level $GuardianLoggerLevel + Write-Host "$guardianCliLocation tsa-onboard --codebase-name `"$TsaCodebaseName`" --notification-alias `"$TsaNotificationEmail`" --codebase-admin `"$TsaCodebaseAdmin`" --instance-url `"$TsaInstanceUrl`" --project-name `"$TsaProjectName`" --area-path `"$TsaBugAreaPath`" --iteration-path `"$TsaIterationPath`" --working-directory $workingDirectory --logger-level $GuardianLoggerLevel" + & $guardianCliLocation tsa-onboard --codebase-name "$TsaCodebaseName" --notification-alias "$TsaNotificationEmail" --codebase-admin "$TsaCodebaseAdmin" --instance-url "$TsaInstanceUrl" --project-name "$TsaProjectName" --area-path "$TsaBugAreaPath" --iteration-path "$TsaIterationPath" --working-directory $workingDirectory --logger-level $GuardianLoggerLevel if ($LASTEXITCODE -ne 0) { Write-Host "Guardian tsa-onboard failed with exit code $LASTEXITCODE." exit $LASTEXITCODE @@ -71,10 +72,10 @@ if ($TsaOnboard) { } if ($ArtifactToolsList -and $ArtifactToolsList.Count -gt 0) { - & $(Join-Path $PSScriptRoot "run-sdl.ps1") -GuardianCliLocation $guardianCliLocation -WorkingDirectory $ArtifactsDirectory -TargetDirectory $ArtifactsDirectory -GdnFolder $gdnFolder -ToolsList $ArtifactToolsList -AzureDevOpsAccessToken $AzureDevOpsAccessToken -UpdateBaseline $UpdateBaseline -GuardianLoggerLevel $GuardianLoggerLevel -CrScanAdditionalRunConfigParams $CrScanAdditionalRunConfigParams -PoliCheckAdditionalRunConfigParams $PoliCheckAdditionalRunConfigParams + & $(Join-Path $PSScriptRoot "run-sdl.ps1") -GuardianCliLocation $guardianCliLocation -WorkingDirectory $workingDirectory -TargetDirectory $ArtifactsDirectory -GdnFolder $gdnFolder -ToolsList $ArtifactToolsList -AzureDevOpsAccessToken $AzureDevOpsAccessToken -UpdateBaseline $UpdateBaseline -GuardianLoggerLevel $GuardianLoggerLevel -CrScanAdditionalRunConfigParams $CrScanAdditionalRunConfigParams -PoliCheckAdditionalRunConfigParams $PoliCheckAdditionalRunConfigParams } if ($SourceToolsList -and $SourceToolsList.Count -gt 0) { - & $(Join-Path $PSScriptRoot "run-sdl.ps1") -GuardianCliLocation $guardianCliLocation -WorkingDirectory $ArtifactsDirectory -TargetDirectory $SourceDirectory -GdnFolder $gdnFolder -ToolsList $SourceToolsList -AzureDevOpsAccessToken $AzureDevOpsAccessToken -UpdateBaseline $UpdateBaseline -GuardianLoggerLevel $GuardianLoggerLevel -CrScanAdditionalRunConfigParams $CrScanAdditionalRunConfigParams -PoliCheckAdditionalRunConfigParams $PoliCheckAdditionalRunConfigParams + & $(Join-Path $PSScriptRoot "run-sdl.ps1") -GuardianCliLocation $guardianCliLocation -WorkingDirectory $workingDirectory -TargetDirectory $SourceDirectory -GdnFolder $gdnFolder -ToolsList $SourceToolsList -AzureDevOpsAccessToken $AzureDevOpsAccessToken -UpdateBaseline $UpdateBaseline -GuardianLoggerLevel $GuardianLoggerLevel -CrScanAdditionalRunConfigParams $CrScanAdditionalRunConfigParams -PoliCheckAdditionalRunConfigParams $PoliCheckAdditionalRunConfigParams } if ($UpdateBaseline) { @@ -86,8 +87,8 @@ if ($TsaPublish) { if (-not $TsaRepositoryName) { $TsaRepositoryName = "$($Repository)-$($BranchName)" } - Write-Host "$guardianCliLocation tsa-publish --all-tools --repository-name `"$TsaRepositoryName`" --branch-name `"$TsaBranchName`" --build-number `"$BuildNumber`" --codebase-name `"$TsaCodebaseName`" --notification-alias `"$TsaNotificationEmail`" --codebase-admin `"$TsaCodebaseAdmin`" --instance-url `"$TsaInstanceUrl`" --project-name `"$TsaProjectName`" --area-path `"$TsaBugAreaPath`" --iteration-path `"$TsaIterationPath`" --working-directory $SourceDirectory --logger-level $GuardianLoggerLevel" - & $guardianCliLocation tsa-publish --all-tools --repository-name "$TsaRepositoryName" --branch-name "$TsaBranchName" --build-number "$BuildNumber" --codebase-name "$TsaCodebaseName" --notification-alias "$TsaNotificationEmail" --codebase-admin "$TsaCodebaseAdmin" --instance-url "$TsaInstanceUrl" --project-name "$TsaProjectName" --area-path "$TsaBugAreaPath" --iteration-path "$TsaIterationPath" --working-directory $ArtifactsDirectory --logger-level $GuardianLoggerLevel + Write-Host "$guardianCliLocation tsa-publish --all-tools --repository-name `"$TsaRepositoryName`" --branch-name `"$TsaBranchName`" --build-number `"$BuildNumber`" --codebase-name `"$TsaCodebaseName`" --notification-alias `"$TsaNotificationEmail`" --codebase-admin `"$TsaCodebaseAdmin`" --instance-url `"$TsaInstanceUrl`" --project-name `"$TsaProjectName`" --area-path `"$TsaBugAreaPath`" --iteration-path `"$TsaIterationPath`" --working-directory $workingDirectory --logger-level $GuardianLoggerLevel" + & $guardianCliLocation tsa-publish --all-tools --repository-name "$TsaRepositoryName" --branch-name "$TsaBranchName" --build-number "$BuildNumber" --onboard $True --codebase-name "$TsaCodebaseName" --notification-alias "$TsaNotificationEmail" --codebase-admin "$TsaCodebaseAdmin" --instance-url "$TsaInstanceUrl" --project-name "$TsaProjectName" --area-path "$TsaBugAreaPath" --iteration-path "$TsaIterationPath" --working-directory $workingDirectory --logger-level $GuardianLoggerLevel if ($LASTEXITCODE -ne 0) { Write-Host "Guardian tsa-publish failed with exit code $LASTEXITCODE." exit $LASTEXITCODE diff --git a/eng/common/sdl/extract-artifact-packages.ps1 b/eng/common/sdl/extract-artifact-packages.ps1 index 1fdbb14329..6e6825013b 100644 --- a/eng/common/sdl/extract-artifact-packages.ps1 +++ b/eng/common/sdl/extract-artifact-packages.ps1 @@ -5,6 +5,13 @@ param( $ErrorActionPreference = "Stop" Set-StrictMode -Version 2.0 + +# `tools.ps1` checks $ci to perform some actions. Since the post-build +# scripts don't necessarily execute in the same agent that run the +# build.ps1/sh script this variable isn't automatically set. +$ci = $true +. $PSScriptRoot\..\tools.ps1 + $ExtractPackage = { param( [string] $PackagePath # Full path to a NuGet package diff --git a/eng/common/sdl/init-sdl.ps1 b/eng/common/sdl/init-sdl.ps1 index 26e01c0673..c737eb0e71 100644 --- a/eng/common/sdl/init-sdl.ps1 +++ b/eng/common/sdl/init-sdl.ps1 @@ -11,6 +11,9 @@ $ErrorActionPreference = "Stop" Set-StrictMode -Version 2.0 $LASTEXITCODE = 0 +# Don't display the console progress UI - it's a huge perf hit +$ProgressPreference = 'SilentlyContinue' + # Construct basic auth from AzDO access token; construct URI to the repository's gdn folder stored in that repository; construct location of zip file $encodedPat = [Convert]::ToBase64String([System.Text.Encoding]::ASCII.GetBytes(":$AzureDevOpsAccessToken")) $escapedRepository = [Uri]::EscapeDataString("/$Repository/$BranchName/.gdn") diff --git a/eng/common/sdl/packages.config b/eng/common/sdl/packages.config index 3f97ac2f16..256ffbfb93 100644 --- a/eng/common/sdl/packages.config +++ b/eng/common/sdl/packages.config @@ -1,4 +1,4 @@ - + - + diff --git a/eng/common/sdl/run-sdl.ps1 b/eng/common/sdl/run-sdl.ps1 index d7b8564458..9bc25314ae 100644 --- a/eng/common/sdl/run-sdl.ps1 +++ b/eng/common/sdl/run-sdl.ps1 @@ -25,43 +25,35 @@ if ($ValidPath -eq $False) exit 1 } +$configParam = @("--config") + foreach ($tool in $ToolsList) { $gdnConfigFile = Join-Path $gdnConfigPath "$tool-configure.gdnconfig" - $config = $False Write-Host $tool # We have to manually configure tools that run on source to look at the source directory only if ($tool -eq "credscan") { - Write-Host "$GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args `" TargetDirectory : $TargetDirectory `" $(If ($CrScanAdditionalRunConfigParams) {$CrScanAdditionalRunConfigParams})" - & $GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args " TargetDirectory : $TargetDirectory " $(If ($CrScanAdditionalRunConfigParams) {$CrScanAdditionalRunConfigParams}) + Write-Host "$GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args `" TargetDirectory < $TargetDirectory `" `" OutputType < pre `" $(If ($CrScanAdditionalRunConfigParams) {$CrScanAdditionalRunConfigParams})" + & $GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args " TargetDirectory < $TargetDirectory " "OutputType < pre" $(If ($CrScanAdditionalRunConfigParams) {$CrScanAdditionalRunConfigParams}) if ($LASTEXITCODE -ne 0) { Write-Host "Guardian configure for $tool failed with exit code $LASTEXITCODE." exit $LASTEXITCODE } - $config = $True } if ($tool -eq "policheck") { - Write-Host "$GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args `" Target : $TargetDirectory `" $(If ($PoliCheckAdditionalRunConfigParams) {$PoliCheckAdditionalRunConfigParams})" - & $GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args " Target : $TargetDirectory " $(If ($PoliCheckAdditionalRunConfigParams) {$PoliCheckAdditionalRunConfigParams}) + Write-Host "$GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args `" Target < $TargetDirectory `" $(If ($PoliCheckAdditionalRunConfigParams) {$PoliCheckAdditionalRunConfigParams})" + & $GuardianCliLocation configure --working-directory $WorkingDirectory --tool $tool --output-path $gdnConfigFile --logger-level $GuardianLoggerLevel --noninteractive --force --args " Target < $TargetDirectory " $(If ($PoliCheckAdditionalRunConfigParams) {$PoliCheckAdditionalRunConfigParams}) if ($LASTEXITCODE -ne 0) { Write-Host "Guardian configure for $tool failed with exit code $LASTEXITCODE." exit $LASTEXITCODE } - $config = $True } - Write-Host "$GuardianCliLocation run --working-directory $WorkingDirectory --tool $tool --baseline mainbaseline --update-baseline $UpdateBaseline --logger-level $GuardianLoggerLevel --config $gdnConfigFile $config" - if ($config) { - & $GuardianCliLocation run --working-directory $WorkingDirectory --tool $tool --baseline mainbaseline --update-baseline $UpdateBaseline --logger-level $GuardianLoggerLevel --config $gdnConfigFile - if ($LASTEXITCODE -ne 0) { - Write-Host "Guardian run for $tool using $gdnConfigFile failed with exit code $LASTEXITCODE." - exit $LASTEXITCODE - } - } else { - & $GuardianCliLocation run --working-directory $WorkingDirectory --tool $tool --baseline mainbaseline --update-baseline $UpdateBaseline --logger-level $GuardianLoggerLevel - if ($LASTEXITCODE -ne 0) { - Write-Host "Guardian run for $tool failed with exit code $LASTEXITCODE." - exit $LASTEXITCODE - } - } + $configParam+=$gdnConfigFile } +Write-Host "$GuardianCliLocation run --working-directory $WorkingDirectory --baseline mainbaseline --update-baseline $UpdateBaseline --logger-level $GuardianLoggerLevel $configParam" +& $GuardianCliLocation run --working-directory $WorkingDirectory --tool $tool --baseline mainbaseline --update-baseline $UpdateBaseline --logger-level $GuardianLoggerLevel $configParam +if ($LASTEXITCODE -ne 0) { + Write-Host "Guardian run for $ToolsList using $configParam failed with exit code $LASTEXITCODE." + exit $LASTEXITCODE +} diff --git a/eng/common/templates/job/execute-sdl.yml b/eng/common/templates/job/execute-sdl.yml index 91621cf88f..9a00430d65 100644 --- a/eng/common/templates/job/execute-sdl.yml +++ b/eng/common/templates/job/execute-sdl.yml @@ -1,7 +1,10 @@ parameters: overrideParameters: '' # Optional: to override values for parameters. additionalParameters: '' # Optional: parameters that need user specific values eg: '-SourceToolsList @("abc","def") -ArtifactToolsList @("ghi","jkl")' - continueOnError: false # optional: determines whether to continue the build if the step errors; + # There is some sort of bug (has been reported) in Azure DevOps where if this parameter is named + # 'continueOnError', the parameter value is not correctly picked up. + # This can also be remedied by the caller (post-build.yml) if it does not use a nested parameter + sdlContinueOnError: false # optional: determines whether to continue the build if the step errors; dependsOn: '' # Optional: dependencies of the job jobs: @@ -21,17 +24,17 @@ jobs: buildType: current downloadType: specific files matchingPattern: "**" - downloadPath: $(Build.SourcesDirectory)\artifacts + downloadPath: $(Build.ArtifactStagingDirectory)\artifacts - powershell: eng/common/sdl/extract-artifact-packages.ps1 - -InputPath $(Build.SourcesDirectory)\artifacts\BlobArtifacts - -ExtractPath $(Build.SourcesDirectory)\artifacts\BlobArtifacts + -InputPath $(Build.ArtifactStagingDirectory)\artifacts\BlobArtifacts + -ExtractPath $(Build.ArtifactStagingDirectory)\artifacts\BlobArtifacts displayName: Extract Blob Artifacts - continueOnError: ${{ parameters.continueOnError }} + continueOnError: ${{ parameters.sdlContinueOnError }} - powershell: eng/common/sdl/extract-artifact-packages.ps1 - -InputPath $(Build.SourcesDirectory)\artifacts\PackageArtifacts - -ExtractPath $(Build.SourcesDirectory)\artifacts\PackageArtifacts + -InputPath $(Build.ArtifactStagingDirectory)\artifacts\PackageArtifacts + -ExtractPath $(Build.ArtifactStagingDirectory)\artifacts\PackageArtifacts displayName: Extract Package Artifacts - continueOnError: ${{ parameters.continueOnError }} + continueOnError: ${{ parameters.sdlContinueOnError }} - task: NuGetToolInstaller@1 displayName: 'Install NuGet.exe' - task: NuGetCommand@2 @@ -45,12 +48,12 @@ jobs: - ${{ if ne(parameters.overrideParameters, '') }}: - powershell: eng/common/sdl/execute-all-sdl-tools.ps1 ${{ parameters.overrideParameters }} displayName: Execute SDL - continueOnError: ${{ parameters.continueOnError }} + continueOnError: ${{ parameters.sdlContinueOnError }} - ${{ if eq(parameters.overrideParameters, '') }}: - powershell: eng/common/sdl/execute-all-sdl-tools.ps1 - -GuardianPackageName Microsoft.Guardian.Cli.0.7.1 + -GuardianPackageName Microsoft.Guardian.Cli.0.7.2 -NugetPackageDirectory $(Build.SourcesDirectory)\.packages -AzureDevOpsAccessToken $(dn-bot-dotnet-build-rw-code-rw) ${{ parameters.additionalParameters }} displayName: Execute SDL - continueOnError: ${{ parameters.continueOnError }} + continueOnError: ${{ parameters.sdlContinueOnError }} diff --git a/eng/common/templates/job/job.yml b/eng/common/templates/job/job.yml index 8db456bb7f..13dd40e26c 100644 --- a/eng/common/templates/job/job.yml +++ b/eng/common/templates/job/job.yml @@ -1,67 +1,33 @@ +# Internal resources (telemetry, microbuild) can only be accessed from non-public projects, +# and some (Microbuild) should only be applied to non-PR cases for internal builds. + parameters: # Job schema parameters - https://docs.microsoft.com/en-us/azure/devops/pipelines/yaml-schema?view=vsts&tabs=schema#job cancelTimeoutInMinutes: '' - condition: '' - - continueOnError: false - container: '' - + continueOnError: false dependsOn: '' - displayName: '' - - steps: [] - pool: '' - + steps: [] strategy: '' - timeoutInMinutes: '' - variables: [] - workspace: '' # Job base template specific parameters - # Optional: Enable installing Microbuild plugin - # if 'true', these "variables" must be specified in the variables object or as part of the queue matrix - # _TeamName - the name of your team - # _SignType - 'test' or 'real' + # See schema documentation in /Documentation/AzureDevOps/TemplateSchema.md + artifacts: '' enableMicrobuild: false - - # Optional: Include PublishBuildArtifacts task enablePublishBuildArtifacts: false - - # Optional: Enable publishing to the build asset registry enablePublishBuildAssets: false - - # Optional: Prevent gather/push manifest from executing when using publishing pipelines - enablePublishUsingPipelines: false - - # Optional: Include PublishTestResults task enablePublishTestResults: false - - # Optional: enable sending telemetry - enableTelemetry: false - - # Optional: define the helix repo for telemetry (example: 'dotnet/arcade') - helixRepo: '' - - # Optional: define the helix type for telemetry (example: 'build/product/') - helixType: '' - - # Required: name of the job + enablePublishUsingPipelines: false name: '' - - # Optional: should run as a public build even in the internal project - # if 'true', the build won't run any of the internal only steps, even if it is running in non-public projects. + preSteps: [] runAsPublic: false -# Internal resources (telemetry, microbuild) can only be accessed from non-public projects, -# and some (Microbuild) should only be applied to non-PR cases for internal builds. - jobs: - job: ${{ parameters.name }} @@ -93,7 +59,7 @@ jobs: timeoutInMinutes: ${{ parameters.timeoutInMinutes }} variables: - - ${{ if eq(parameters.enableTelemetry, 'true') }}: + - ${{ if ne(parameters.enableTelemetry, 'false') }}: - name: DOTNET_CLI_TELEMETRY_PROFILE value: '$(Build.Repository.Uri)' - ${{ each variable in parameters.variables }}: @@ -125,21 +91,12 @@ jobs: workspace: ${{ parameters.workspace }} steps: - - ${{ if eq(parameters.enableTelemetry, 'true') }}: - # Telemetry tasks are built from https://github.com/dotnet/arcade-extensions - - task: sendStartTelemetry@0 - displayName: 'Send Helix Start Telemetry' - inputs: - helixRepo: ${{ parameters.helixRepo }} - ${{ if ne(parameters.helixType, '') }}: - helixType: ${{ parameters.helixType }} - buildConfig: $(_BuildConfig) - runAsPublic: ${{ parameters.runAsPublic }} - continueOnError: ${{ parameters.continueOnError }} - condition: always() + - ${{ if ne(parameters.preSteps, '') }}: + - ${{ each preStep in parameters.preSteps }}: + - ${{ preStep }} - - ${{ if eq(parameters.enableMicrobuild, 'true') }}: - - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: + - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: + - ${{ if eq(parameters.enableMicrobuild, 'true') }}: - task: MicroBuildSigningPlugin@2 displayName: Install MicroBuild plugin inputs: @@ -151,6 +108,16 @@ jobs: continueOnError: ${{ parameters.continueOnError }} condition: and(succeeded(), in(variables['_SignType'], 'real', 'test'), eq(variables['Agent.Os'], 'Windows_NT')) + - task: NuGetAuthenticate@0 + + - ${{ if or(eq(parameters.artifacts.download, 'true'), ne(parameters.artifacts.download, '')) }}: + - task: DownloadPipelineArtifact@2 + inputs: + buildType: current + artifactName: ${{ coalesce(parameters.artifacts.download.name, 'Artifacts_$(Agent.OS)_$(_BuildConfig)') }} + targetPath: ${{ coalesce(parameters.artifacts.download.path, 'artifacts') }} + itemPattern: ${{ coalesce(parameters.artifacts.download.pattern, '**') }} + - ${{ each step in parameters.steps }}: - ${{ step }} @@ -163,20 +130,60 @@ jobs: env: TeamName: $(_TeamName) - - ${{ if eq(parameters.enableTelemetry, 'true') }}: - # Telemetry tasks are built from https://github.com/dotnet/arcade-extensions - - task: sendEndTelemetry@0 - displayName: 'Send Helix End Telemetry' - continueOnError: ${{ parameters.continueOnError }} - condition: always() - - - ${{ if eq(parameters.enablePublishBuildArtifacts, 'true') }}: + - ${{ if ne(parameters.artifacts.publish, '') }}: + - ${{ if or(eq(parameters.artifacts.publish.artifacts, 'true'), ne(parameters.artifacts.publish.artifacts, '')) }}: + - task: CopyFiles@2 + displayName: Gather binaries for publish to artifacts + inputs: + SourceFolder: 'artifacts/bin' + Contents: '**' + TargetFolder: '$(Build.ArtifactStagingDirectory)/artifacts/bin' + - task: CopyFiles@2 + displayName: Gather packages for publish to artifacts + inputs: + SourceFolder: 'artifacts/packages' + Contents: '**' + TargetFolder: '$(Build.ArtifactStagingDirectory)/artifacts/packages' + - task: PublishBuildArtifacts@1 + displayName: Publish pipeline artifacts + inputs: + PathtoPublish: '$(Build.ArtifactStagingDirectory)/artifacts' + PublishLocation: Container + ArtifactName: ${{ coalesce(parameters.artifacts.publish.artifacts.name , 'Artifacts_$(Agent.Os)_$(_BuildConfig)') }} + continueOnError: true + condition: always() + - ${{ if or(eq(parameters.artifacts.publish.logs, 'true'), ne(parameters.artifacts.publish.logs, '')) }}: + - publish: artifacts/log + artifact: ${{ coalesce(parameters.artifacts.publish.logs.name, 'Logs_Build_$(Agent.Os)_$(_BuildConfig)') }} + displayName: Publish logs + continueOnError: true + condition: always() + - ${{ if or(eq(parameters.artifacts.publish.manifests, 'true'), ne(parameters.artifacts.publish.manifests, '')) }}: + - ${{ if and(ne(parameters.enablePublishUsingPipelines, 'true'), eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: + - task: CopyFiles@2 + displayName: Gather Asset Manifests + inputs: + SourceFolder: '$(Build.SourcesDirectory)/artifacts/log/$(_BuildConfig)/AssetManifest' + TargetFolder: '$(Build.ArtifactStagingDirectory)/AssetManifests' + continueOnError: ${{ parameters.continueOnError }} + condition: and(succeeded(), eq(variables['_DotNetPublishToBlobFeed'], 'true')) + + - task: PublishBuildArtifacts@1 + displayName: Push Asset Manifests + inputs: + PathtoPublish: '$(Build.ArtifactStagingDirectory)/AssetManifests' + PublishLocation: Container + ArtifactName: AssetManifests + continueOnError: ${{ parameters.continueOnError }} + condition: and(succeeded(), eq(variables['_DotNetPublishToBlobFeed'], 'true')) + + - ${{ if ne(parameters.enablePublishBuildArtifacts, 'false') }}: - task: PublishBuildArtifacts@1 displayName: Publish Logs inputs: PathtoPublish: '$(Build.SourcesDirectory)/artifacts/log/$(_BuildConfig)' PublishLocation: Container - ArtifactName: $(Agent.Os)_$(Agent.JobName) + ArtifactName: ${{ coalesce(parameters.enablePublishBuildArtifacts.artifactName, '$(Agent.Os)_$(Agent.JobName)' ) }} continueOnError: true condition: always() diff --git a/eng/common/templates/job/performance.yml b/eng/common/templates/job/performance.yml index ef809253d1..f877fd7a89 100644 --- a/eng/common/templates/job/performance.yml +++ b/eng/common/templates/job/performance.yml @@ -5,6 +5,7 @@ parameters: displayName: '' # optional -- display name for the job. Will use jobName if not passed pool: '' # required -- name of the Build pool container: '' # required -- name of the container + osGroup: '' # required -- operating system for the job extraSetupParameters: '' # optional -- extra arguments to pass to the setup script frameworks: ['netcoreapp3.0'] # optional -- list of frameworks to run against continueOnError: 'false' # optional -- determines whether to continue the build if the step errors @@ -44,12 +45,13 @@ jobs: - HelixPreCommand: '' - ${{ if and(ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: - - ${{ if eq(variables['Agent.Os'], 'Windows_NT') }}: + - ${{ if eq( parameters.osGroup, 'Windows_NT') }}: - HelixPreCommand: 'set "PERFLAB_UPLOAD_TOKEN=$(PerfCommandUploadToken)"' - IsInternal: -Internal - - ${{ if ne(variables['Agent.Os'], 'Windows_NT') }}: + - ${{ if ne(parameters.osGroup, 'Windows_NT') }}: - HelixPreCommand: 'export PERFLAB_UPLOAD_TOKEN="$(PerfCommandUploadTokenLinux)"' - IsInternal: --internal + - group: DotNet-HelixApi-Access - group: dotnet-benchview diff --git a/eng/common/templates/job/publish-build-assets.yml b/eng/common/templates/job/publish-build-assets.yml index 9e77ef1b54..b722975f9c 100644 --- a/eng/common/templates/job/publish-build-assets.yml +++ b/eng/common/templates/job/publish-build-assets.yml @@ -47,6 +47,10 @@ jobs: downloadPath: '$(Build.StagingDirectory)/Download' condition: ${{ parameters.condition }} continueOnError: ${{ parameters.continueOnError }} + + - ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: + - task: NuGetAuthenticate@0 + - task: PowerShell@2 displayName: Publish Build Assets inputs: @@ -59,6 +63,7 @@ jobs: /p:Configuration=$(_BuildConfig) condition: ${{ parameters.condition }} continueOnError: ${{ parameters.continueOnError }} + - task: powershell@2 displayName: Create ReleaseConfigs Artifact inputs: @@ -67,12 +72,14 @@ jobs: Add-Content -Path "$(Build.StagingDirectory)/ReleaseConfigs.txt" -Value $(BARBuildId) Add-Content -Path "$(Build.StagingDirectory)/ReleaseConfigs.txt" -Value "$(DefaultChannels)" Add-Content -Path "$(Build.StagingDirectory)/ReleaseConfigs.txt" -Value $(IsStableBuild) + - task: PublishBuildArtifacts@1 displayName: Publish ReleaseConfigs Artifact inputs: PathtoPublish: '$(Build.StagingDirectory)/ReleaseConfigs.txt' PublishLocation: Container ArtifactName: ReleaseConfigs + - ${{ if eq(parameters.enablePublishBuildArtifacts, 'true') }}: - task: PublishBuildArtifacts@1 displayName: Publish Logs to VSTS diff --git a/eng/common/templates/jobs/jobs.yml b/eng/common/templates/jobs/jobs.yml index 6a2f98c036..c08225a9a9 100644 --- a/eng/common/templates/jobs/jobs.yml +++ b/eng/common/templates/jobs/jobs.yml @@ -1,19 +1,10 @@ parameters: - # Optional: 'true' if failures in job.yml job should not fail the job + # See schema documentation in /Documentation/AzureDevOps/TemplateSchema.md continueOnError: false - # Optional: Enable installing Microbuild plugin - # if 'true', these "variables" must be specified in the variables object or as part of the queue matrix - # _TeamName - the name of your team - # _SignType - 'test' or 'real' - enableMicrobuild: false - # Optional: Include PublishBuildArtifacts task enablePublishBuildArtifacts: false - # Optional: Enable publishing to the build asset registry - enablePublishBuildAssets: false - # Optional: Enable publishing using release pipelines enablePublishUsingPipelines: false @@ -23,19 +14,9 @@ parameters: # Optional: Include toolset dependencies in the generated graph files includeToolset: false - # Optional: Include PublishTestResults task - enablePublishTestResults: false - - # Optional: enable sending telemetry - # if enabled then the 'helixRepo' parameter should also be specified - enableTelemetry: false - # Required: A collection of jobs to run - https://docs.microsoft.com/en-us/azure/devops/pipelines/yaml-schema?view=vsts&tabs=schema#job jobs: [] - # Optional: define the helix repo for telemetry (example: 'dotnet/arcade') - helixRepo: '' - # Optional: Override automatically derived dependsOn value for "publish build assets" job publishBuildAssetsDependsOn: '' @@ -62,29 +43,30 @@ jobs: name: ${{ job.job }} -- ${{ if and(eq(parameters.enablePublishBuildAssets, true), eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: - - template: ../job/publish-build-assets.yml - parameters: - continueOnError: ${{ parameters.continueOnError }} - dependsOn: - - ${{ if ne(parameters.publishBuildAssetsDependsOn, '') }}: - - ${{ each job in parameters.publishBuildAssetsDependsOn }}: - - ${{ job.job }} - - ${{ if eq(parameters.publishBuildAssetsDependsOn, '') }}: - - ${{ each job in parameters.jobs }}: - - ${{ job.job }} - pool: - vmImage: vs2017-win2016 - runAsPublic: ${{ parameters.runAsPublic }} - publishUsingPipelines: ${{ parameters.enablePublishUsingPipelines }} - enablePublishBuildArtifacts: ${{ parameters.enablePublishBuildArtifacts }} - -- ${{ if and(eq(parameters.graphFileGeneration.enabled, true), eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: - - template: ../job/generate-graph-files.yml - parameters: - continueOnError: ${{ parameters.continueOnError }} - includeToolset: ${{ parameters.graphFileGeneration.includeToolset }} - dependsOn: - - Asset_Registry_Publish - pool: - vmImage: vs2017-win2016 +- ${{ if and(eq(parameters.runAsPublic, 'false'), ne(variables['System.TeamProject'], 'public'), notin(variables['Build.Reason'], 'PullRequest')) }}: + - ${{ if or(eq(parameters.enablePublishBuildAssets, true), eq(parameters.artifacts.publish.manifests, 'true'), ne(parameters.artifacts.publish.manifests, '')) }}: + - template: ../job/publish-build-assets.yml + parameters: + continueOnError: ${{ parameters.continueOnError }} + dependsOn: + - ${{ if ne(parameters.publishBuildAssetsDependsOn, '') }}: + - ${{ each job in parameters.publishBuildAssetsDependsOn }}: + - ${{ job.job }} + - ${{ if eq(parameters.publishBuildAssetsDependsOn, '') }}: + - ${{ each job in parameters.jobs }}: + - ${{ job.job }} + pool: + vmImage: vs2017-win2016 + runAsPublic: ${{ parameters.runAsPublic }} + publishUsingPipelines: ${{ parameters.enablePublishUsingPipelines }} + enablePublishBuildArtifacts: ${{ parameters.enablePublishBuildArtifacts }} + + - ${{ if eq(parameters.graphFileGeneration.enabled, true) }}: + - template: ../job/generate-graph-files.yml + parameters: + continueOnError: ${{ parameters.continueOnError }} + includeToolset: ${{ parameters.graphFileGeneration.includeToolset }} + dependsOn: + - Asset_Registry_Publish + pool: + vmImage: vs2017-win2016 diff --git a/eng/common/templates/post-build/channels/internal-servicing.yml b/eng/common/templates/post-build/channels/internal-servicing.yml index dc065ab308..12fd2b4653 100644 --- a/eng/common/templates/post-build/channels/internal-servicing.yml +++ b/eng/common/templates/post-build/channels/internal-servicing.yml @@ -13,7 +13,7 @@ stages: - job: displayName: Symbol Publishing dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.InternalServicing_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.InternalServicing_30_Channel_Id) variables: - group: DotNet-Symbol-Server-Pats pool: @@ -46,7 +46,7 @@ stages: value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] - name: IsStableBuild value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.InternalServicing_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.InternalServicing_30_Channel_Id) pool: vmImage: 'windows-2019' steps: @@ -126,7 +126,7 @@ stages: - job: displayName: Symbol Availability dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.InternalServicing_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.InternalServicing_30_Channel_Id) pool: vmImage: 'windows-2019' steps: diff --git a/eng/common/templates/post-build/channels/netcore-dev-31.yml b/eng/common/templates/post-build/channels/netcore-dev-31.yml new file mode 100644 index 0000000000..af64724f79 --- /dev/null +++ b/eng/common/templates/post-build/channels/netcore-dev-31.yml @@ -0,0 +1,132 @@ +parameters: + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + symbolPublishingAdditionalParameters: '' + +stages: +- stage: NetCore_Dev31_Publish + dependsOn: ${{ parameters.dependsOn }} + variables: + - template: ../common-variables.yml + displayName: .NET Core 3.1 Dev Publishing + jobs: + - template: ../setup-maestro-vars.yml + + - job: + displayName: Symbol Publishing + dependsOn: setupMaestroVars + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicDevRelease_31_Channel_Id)) + variables: + - group: DotNet-Symbol-Server-Pats + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts + inputs: + artifactName: 'PDBArtifacts' + continueOnError: true + + - task: PowerShell@2 + displayName: Publish + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' + /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} + + - job: publish_assets + displayName: Publish Assets + dependsOn: setupMaestroVars + variables: + - group: DotNet-Blob-Feed + - group: AzureDevOps-Artifact-Feeds-Pats + - name: BARBuildId + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] + - name: IsStableBuild + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicDevRelease_31_Channel_Id)) + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Package Artifacts + inputs: + buildType: current + artifactName: PackageArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + buildType: current + artifactName: BlobArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Asset Manifests + inputs: + buildType: current + artifactName: AssetManifests + + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish Assets + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet + /p:ArtifactsCategory=$(_DotNetArtifactsCategory) + /p:IsStableBuild=$(IsStableBuild) + /p:IsInternalBuild=$(IsInternalBuild) + /p:RepositoryName=$(Build.Repository.Name) + /p:CommitSha=$(Build.SourceVersion) + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1-transport/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} + + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.PublicDevRelease_31_Channel_Id }} diff --git a/eng/common/templates/post-build/channels/netcore-dev-5.yml b/eng/common/templates/post-build/channels/netcore-dev-5.yml index f2b0cfb269..6c8dff5424 100644 --- a/eng/common/templates/post-build/channels/netcore-dev-5.yml +++ b/eng/common/templates/post-build/channels/netcore-dev-5.yml @@ -1,12 +1,16 @@ parameters: - enableSymbolValidation: true + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + symbolPublishingAdditionalParameters: '' stages: - stage: NetCore_Dev5_Publish - dependsOn: validate + dependsOn: ${{ parameters.dependsOn }} variables: - template: ../common-variables.yml - displayName: .NET Core 5 Dev Channel + displayName: .NET Core 5 Dev Publishing jobs: - template: ../setup-maestro-vars.yml @@ -20,23 +24,31 @@ stages: vmImage: 'windows-2019' steps: - task: DownloadBuildArtifacts@0 - displayName: Download Artifacts + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts inputs: - downloadType: specific files - matchingPattern: "*Artifacts*" + artifactName: 'PDBArtifacts' + continueOnError: true - task: PowerShell@2 displayName: Publish inputs: filePath: eng\common\sdk-task.ps1 arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet - /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) - /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} - - job: + - job: publish_assets displayName: Publish Assets dependsOn: setupMaestroVars variables: @@ -68,81 +80,53 @@ stages: buildType: current artifactName: AssetManifests + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + - task: PowerShell@2 - displayName: Add Assets Location - env: - AZURE_DEVOPS_EXT_PAT: $(dn-bot-dnceng-unviersal-packages-rw) + displayName: Publish Assets inputs: filePath: eng\common\sdk-task.ps1 - arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet - /p:ChannelId=$(NetCore_5_Dev_Channel_Id) + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet /p:ArtifactsCategory=$(_DotNetArtifactsCategory) /p:IsStableBuild=$(IsStableBuild) /p:IsInternalBuild=$(IsInternalBuild) /p:RepositoryName=$(Build.Repository.Name) /p:CommitSha=$(Build.SourceVersion) - /p:NugetPath=$(Agent.BuildDirectory)\Nuget\NuGet.exe - /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:TargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' - /p:BARBuildId=$(BARBuildId) - /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' - /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' - /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' - /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' - /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' - /p:Configuration=Release - - - task: NuGetCommand@2 - displayName: Publish Packages to AzDO Feed - condition: contains(variables['TargetAzDOFeed'], 'pkgs.visualstudio.com') - inputs: - command: push - vstsFeed: $(AzDoFeedName) - packagesToPush: $(Build.ArtifactStagingDirectory)\PackageArtifacts\*.nupkg - publishVstsFeed: $(AzDoFeedName) - - - task: PowerShell@2 - displayName: Publish Blobs to AzDO Feed - inputs: - filePath: $(Build.SourcesDirectory)/eng/common/post-build/publish-blobs-to-azdo.ps1 - arguments: -FeedName $(AzDoFeedName) - -SourceFolderCollection $(Build.ArtifactStagingDirectory)/BlobArtifacts/ - -PersonalAccessToken $(dn-bot-dnceng-unviersal-packages-rw) - enabled: false - - -- stage: NetCore_Dev5_PublishValidation - displayName: Publish Validation - variables: - - template: ../common-variables.yml - jobs: - - template: ../setup-maestro-vars.yml - - - ${{ if eq(parameters.enableSymbolValidation, 'true') }}: - - job: - displayName: Symbol Availability - dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.NetCore_5_Dev_Channel_Id)) - pool: - vmImage: 'windows-2019' - steps: - - task: DownloadBuildArtifacts@0 - displayName: Download Package Artifacts - inputs: - buildType: current - artifactName: PackageArtifacts - - - task: PowerShell@2 - displayName: Check Symbol Availability - inputs: - filePath: $(Build.SourcesDirectory)/eng/common/post-build/symbols-validation.ps1 - arguments: -InputPath $(Build.ArtifactStagingDirectory)/PackageArtifacts/ -ExtractPath $(Agent.BuildDirectory)/Temp/ -DotnetSymbolVersion $(SymbolToolVersion) - - - template: ../darc-gather-drop.yml - parameters: - ChannelId: ${{ variables.NetCore_5_Dev_Channel_Id }} + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet5/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet5-transport/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet5-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} - - template: ../promote-build.yml - parameters: - ChannelId: ${{ variables.NetCore_5_Dev_Channel_Id }} + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.NetCore_5_Dev_Channel_Id }} diff --git a/eng/common/templates/post-build/channels/netcore-internal-30.yml b/eng/common/templates/post-build/channels/netcore-internal-30.yml new file mode 100644 index 0000000000..201ed570ae --- /dev/null +++ b/eng/common/templates/post-build/channels/netcore-internal-30.yml @@ -0,0 +1,142 @@ +parameters: + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + symbolPublishingAdditionalParameters: '' + +stages: +- stage: NetCore_30_Internal_Servicing_Publishing + dependsOn: ${{ parameters.dependsOn }} + variables: + - template: ../common-variables.yml + displayName: .NET Core 3.0 Internal Servicing Publishing + jobs: + - template: ../setup-maestro-vars.yml + + - job: + displayName: Symbol Publishing + dependsOn: setupMaestroVars + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.InternalServicing_30_Channel_Id)) + variables: + - group: DotNet-Symbol-Server-Pats + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts + inputs: + artifactName: 'PDBArtifacts' + continueOnError: true + + # This is necessary whenever we want to publish/restore to an AzDO private feed + # Since sdk-task.ps1 tries to restore packages we need to do this authentication here + # otherwise it'll complain about accessing a private feed. + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' + /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} + + - job: publish_assets + displayName: Publish Assets + dependsOn: setupMaestroVars + variables: + - group: DotNet-Blob-Feed + - group: AzureDevOps-Artifact-Feeds-Pats + - name: BARBuildId + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] + - name: IsStableBuild + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.InternalServicing_30_Channel_Id)) + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Package Artifacts + inputs: + buildType: current + artifactName: PackageArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + buildType: current + artifactName: BlobArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Asset Manifests + inputs: + buildType: current + artifactName: AssetManifests + + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish Assets + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet + /p:IsStableBuild=$(IsStableBuild) + /p:IsInternalBuild=$(IsInternalBuild) + /p:RepositoryName=$(Build.Repository.Name) + /p:CommitSha=$(Build.SourceVersion) + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=true + /p:ChecksumsTargetStaticFeed=$(InternalChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(InternalChecksumsBlobFeedKey) + /p:InstallersTargetStaticFeed=$(InternalInstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(InternalInstallersBlobFeedKey) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/_packaging/dotnet3-internal/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/_packaging/dotnet3-internal-transport/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/_packaging/dotnet3-internal-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} + + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.InternalServicing_30_Channel_Id }} diff --git a/eng/common/templates/post-build/channels/netcore-release-30.yml b/eng/common/templates/post-build/channels/netcore-release-30.yml new file mode 100644 index 0000000000..206dd43e3a --- /dev/null +++ b/eng/common/templates/post-build/channels/netcore-release-30.yml @@ -0,0 +1,132 @@ +parameters: + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + symbolPublishingAdditionalParameters: '' + +stages: +- stage: NetCore_Release30_Publish + dependsOn: ${{ parameters.dependsOn }} + variables: + - template: ../common-variables.yml + displayName: .NET Core 3.0 Release Publishing + jobs: + - template: ../setup-maestro-vars.yml + + - job: + displayName: Symbol Publishing + dependsOn: setupMaestroVars + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_30_Channel_Id)) + variables: + - group: DotNet-Symbol-Server-Pats + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts + inputs: + artifactName: 'PDBArtifacts' + continueOnError: true + + - task: PowerShell@2 + displayName: Publish + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' + /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} + + - job: publish_assets + displayName: Publish Assets + dependsOn: setupMaestroVars + variables: + - group: DotNet-Blob-Feed + - group: AzureDevOps-Artifact-Feeds-Pats + - name: BARBuildId + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] + - name: IsStableBuild + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_30_Channel_Id)) + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Package Artifacts + inputs: + buildType: current + artifactName: PackageArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + buildType: current + artifactName: BlobArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Asset Manifests + inputs: + buildType: current + artifactName: AssetManifests + + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish Assets + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet + /p:ArtifactsCategory=$(_DotNetArtifactsCategory) + /p:IsStableBuild=$(IsStableBuild) + /p:IsInternalBuild=$(IsInternalBuild) + /p:RepositoryName=$(Build.Repository.Name) + /p:CommitSha=$(Build.SourceVersion) + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3-transport/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} + + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.PublicRelease_30_Channel_Id }} diff --git a/eng/common/templates/post-build/channels/netcore-release-31.yml b/eng/common/templates/post-build/channels/netcore-release-31.yml new file mode 100644 index 0000000000..6270c82835 --- /dev/null +++ b/eng/common/templates/post-build/channels/netcore-release-31.yml @@ -0,0 +1,132 @@ +parameters: + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + symbolPublishingAdditionalParameters: '' + +stages: +- stage: NetCore_Release31_Publish + dependsOn: ${{ parameters.dependsOn }} + variables: + - template: ../common-variables.yml + displayName: .NET Core 3.1 Release Publishing + jobs: + - template: ../setup-maestro-vars.yml + + - job: + displayName: Symbol Publishing + dependsOn: setupMaestroVars + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_31_Channel_Id)) + variables: + - group: DotNet-Symbol-Server-Pats + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts + inputs: + artifactName: 'PDBArtifacts' + continueOnError: true + + - task: PowerShell@2 + displayName: Publish + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' + /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} + + - job: publish_assets + displayName: Publish Assets + dependsOn: setupMaestroVars + variables: + - group: DotNet-Blob-Feed + - group: AzureDevOps-Artifact-Feeds-Pats + - name: BARBuildId + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] + - name: IsStableBuild + value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_31_Channel_Id)) + pool: + vmImage: 'windows-2019' + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Package Artifacts + inputs: + buildType: current + artifactName: PackageArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Blob Artifacts + inputs: + buildType: current + artifactName: BlobArtifacts + + - task: DownloadBuildArtifacts@0 + displayName: Download Asset Manifests + inputs: + buildType: current + artifactName: AssetManifests + + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish Assets + inputs: + filePath: eng\common\sdk-task.ps1 + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet + /p:ArtifactsCategory=$(_DotNetArtifactsCategory) + /p:IsStableBuild=$(IsStableBuild) + /p:IsInternalBuild=$(IsInternalBuild) + /p:RepositoryName=$(Build.Repository.Name) + /p:CommitSha=$(Build.SourceVersion) + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1-transport/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet3.1-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} + + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.PublicRelease_31_Channel_Id }} diff --git a/eng/common/templates/post-build/channels/netcore-tools-latest.yml b/eng/common/templates/post-build/channels/netcore-tools-latest.yml index fd6c09b227..9bf9626ca3 100644 --- a/eng/common/templates/post-build/channels/netcore-tools-latest.yml +++ b/eng/common/templates/post-build/channels/netcore-tools-latest.yml @@ -1,12 +1,16 @@ parameters: - enableSymbolValidation: true + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + symbolPublishingAdditionalParameters: '' stages: - stage: NetCore_Tools_Latest_Publish - dependsOn: validate + dependsOn: ${{ parameters.dependsOn }} variables: - template: ../common-variables.yml - displayName: .NET Tools - Latest + displayName: .NET Tools - Latest Publishing jobs: - template: ../setup-maestro-vars.yml @@ -20,23 +24,31 @@ stages: vmImage: 'windows-2019' steps: - task: DownloadBuildArtifacts@0 - displayName: Download Artifacts + displayName: Download Blob Artifacts + inputs: + artifactName: 'BlobArtifacts' + continueOnError: true + + - task: DownloadBuildArtifacts@0 + displayName: Download PDB Artifacts inputs: - downloadType: specific files - matchingPattern: "*Artifacts*" + artifactName: 'PDBArtifacts' + continueOnError: true - task: PowerShell@2 displayName: Publish inputs: filePath: eng\common\sdk-task.ps1 arguments: -task PublishToSymbolServers -restore -msbuildEngine dotnet - /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) - /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) + /p:DotNetSymbolServerTokenMsdl=$(microsoft-symbol-server-pat) + /p:DotNetSymbolServerTokenSymWeb=$(symweb-symbol-server-pat) /p:PDBArtifactsDirectory='$(Build.ArtifactStagingDirectory)/PDBArtifacts/' /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:SymbolPublishingExclusionsFile='$(Build.SourcesDirectory)/eng/SymbolPublishingExclusionsFile.txt' /p:Configuration=Release + ${{ parameters.symbolPublishingAdditionalParameters }} - - job: + - job: publish_assets displayName: Publish Assets dependsOn: setupMaestroVars variables: @@ -68,81 +80,53 @@ stages: buildType: current artifactName: AssetManifests + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + - task: PowerShell@2 - displayName: Add Assets Location - env: - AZURE_DEVOPS_EXT_PAT: $(dn-bot-dnceng-unviersal-packages-rw) + displayName: Publish Assets inputs: filePath: eng\common\sdk-task.ps1 - arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet - /p:ChannelId=$(NetCore_Tools_Latest_Channel_Id) + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet /p:ArtifactsCategory=$(_DotNetArtifactsCategory) /p:IsStableBuild=$(IsStableBuild) /p:IsInternalBuild=$(IsInternalBuild) /p:RepositoryName=$(Build.Repository.Name) /p:CommitSha=$(Build.SourceVersion) - /p:NugetPath=$(Agent.BuildDirectory)\Nuget\NuGet.exe - /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:TargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' - /p:BARBuildId=$(BARBuildId) - /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' - /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' - /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' - /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' - /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' - /p:Configuration=Release - - - task: NuGetCommand@2 - displayName: Publish Packages to AzDO Feed - condition: contains(variables['TargetAzDOFeed'], 'pkgs.visualstudio.com') - inputs: - command: push - vstsFeed: $(AzDoFeedName) - packagesToPush: $(Build.ArtifactStagingDirectory)\PackageArtifacts\*.nupkg - publishVstsFeed: $(AzDoFeedName) - - - task: PowerShell@2 - displayName: Publish Blobs to AzDO Feed - inputs: - filePath: $(Build.SourcesDirectory)/eng/common/post-build/publish-blobs-to-azdo.ps1 - arguments: -FeedName $(AzDoFeedName) - -SourceFolderCollection $(Build.ArtifactStagingDirectory)/BlobArtifacts/ - -PersonalAccessToken $(dn-bot-dnceng-unviersal-packages-rw) - enabled: false - - -- stage: NetCore_Tools_Latest_PublishValidation - displayName: Publish Validation - variables: - - template: ../common-variables.yml - jobs: - - template: ../setup-maestro-vars.yml - - - ${{ if eq(parameters.enableSymbolValidation, 'true') }}: - - job: - displayName: Symbol Availability - dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.NetCore_Tools_Latest_Channel_Id)) - pool: - vmImage: 'windows-2019' - steps: - - task: DownloadBuildArtifacts@0 - displayName: Download Package Artifacts - inputs: - buildType: current - artifactName: PackageArtifacts - - - task: PowerShell@2 - displayName: Check Symbol Availability - inputs: - filePath: $(Build.SourcesDirectory)/eng/common/post-build/symbols-validation.ps1 - arguments: -InputPath $(Build.ArtifactStagingDirectory)/PackageArtifacts/ -ExtractPath $(Agent.BuildDirectory)/Temp/ -DotnetSymbolVersion $(SymbolToolVersion) - - - template: ../darc-gather-drop.yml - parameters: - ChannelId: ${{ variables.NetCore_Tools_Latest_Channel_Id }} + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} - - template: ../promote-build.yml - parameters: - ChannelId: ${{ variables.NetCore_Tools_Latest_Channel_Id }} + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.NetCore_Tools_Latest_Channel_Id }} \ No newline at end of file diff --git a/eng/common/templates/post-build/channels/public-dev-release.yml b/eng/common/templates/post-build/channels/public-dev-release.yml index 771dcf4ef8..afc5d36423 100644 --- a/eng/common/templates/post-build/channels/public-dev-release.yml +++ b/eng/common/templates/post-build/channels/public-dev-release.yml @@ -13,7 +13,7 @@ stages: - job: displayName: Symbol Publishing dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicDevRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicDevRelease_30_Channel_Id) variables: - group: DotNet-Symbol-Server-Pats pool: @@ -46,7 +46,7 @@ stages: value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] - name: IsStableBuild value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicDevRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicDevRelease_30_Channel_Id) pool: vmImage: 'windows-2019' steps: @@ -111,7 +111,6 @@ stages: -PersonalAccessToken $(dn-bot-dnceng-unviersal-packages-rw) enabled: false - - stage: PublishValidation displayName: Publish Validation variables: @@ -123,7 +122,7 @@ stages: - job: displayName: Symbol Availability dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicDevRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicDevRelease_30_Channel_Id) pool: vmImage: 'windows-2019' steps: diff --git a/eng/common/templates/post-build/channels/public-release.yml b/eng/common/templates/post-build/channels/public-release.yml index 00108bd3f8..4c63fb43f0 100644 --- a/eng/common/templates/post-build/channels/public-release.yml +++ b/eng/common/templates/post-build/channels/public-release.yml @@ -13,7 +13,7 @@ stages: - job: displayName: Symbol Publishing dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicRelease_30_Channel_Id) variables: - group: DotNet-Symbol-Server-Pats pool: @@ -46,7 +46,7 @@ stages: value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.BARBuildId'] ] - name: IsStableBuild value: $[ dependencies.setupMaestroVars.outputs['setReleaseVars.IsStableBuild'] ] - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicRelease_30_Channel_Id) pool: vmImage: 'windows-2019' steps: @@ -126,7 +126,7 @@ stages: - job: displayName: Symbol Availability dependsOn: setupMaestroVars - condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], format('[{0}]', variables.PublicRelease_30_Channel_Id)) + condition: contains(dependencies.setupMaestroVars.outputs['setReleaseVars.InitialChannels'], variables.PublicRelease_30_Channel_Id) pool: vmImage: 'windows-2019' steps: diff --git a/eng/common/templates/post-build/channels/public-validation-release.yml b/eng/common/templates/post-build/channels/public-validation-release.yml index f64184da9f..5c8e91cce1 100644 --- a/eng/common/templates/post-build/channels/public-validation-release.yml +++ b/eng/common/templates/post-build/channels/public-validation-release.yml @@ -1,13 +1,19 @@ +parameters: + artifactsPublishingAdditionalParameters: '' + dependsOn: + - Validate + publishInstallersAndChecksums: false + stages: - stage: PVR_Publish - dependsOn: validate + dependsOn: ${{ parameters.dependsOn }} variables: - template: ../common-variables.yml - displayName: Validation Channel + displayName: .NET Tools - Validation Publishing jobs: - template: ../setup-maestro-vars.yml - - job: + - job: publish_assets displayName: Publish Assets dependsOn: setupMaestroVars variables: @@ -39,61 +45,53 @@ stages: buildType: current artifactName: AssetManifests + - task: NuGetToolInstaller@1 + displayName: 'Install NuGet.exe' + + # This is necessary whenever we want to publish/restore to an AzDO private feed + - task: NuGetAuthenticate@0 + displayName: 'Authenticate to AzDO Feeds' + - task: PowerShell@2 - displayName: Add Assets Location - env: - AZURE_DEVOPS_EXT_PAT: $(dn-bot-dnceng-unviersal-packages-rw) + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + + - task: PowerShell@2 + displayName: Publish Assets inputs: filePath: eng\common\sdk-task.ps1 - arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet - /p:ChannelId=$(PublicValidationRelease_30_Channel_Id) + arguments: -task PublishArtifactsInManifest -restore -msbuildEngine dotnet /p:ArtifactsCategory=$(_DotNetValidationArtifactsCategory) /p:IsStableBuild=$(IsStableBuild) /p:IsInternalBuild=$(IsInternalBuild) /p:RepositoryName=$(Build.Repository.Name) /p:CommitSha=$(Build.SourceVersion) - /p:NugetPath=$(Agent.BuildDirectory)\Nuget\NuGet.exe - /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:TargetFeedPAT='$(dn-bot-dnceng-unviersal-packages-rw)' - /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' - /p:BARBuildId=$(BARBuildId) - /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' - /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' - /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' - /p:BlobBasePath='$(Build.ArtifactStagingDirectory)\BlobArtifacts' - /p:PackageBasePath='$(Build.ArtifactStagingDirectory)\PackageArtifacts' - /p:Configuration=Release - - - task: NuGetCommand@2 - displayName: Publish Packages to AzDO Feed - condition: contains(variables['TargetAzDOFeed'], 'pkgs.visualstudio.com') - inputs: - command: push - vstsFeed: $(AzDoFeedName) - packagesToPush: $(Build.ArtifactStagingDirectory)\PackageArtifacts\*.nupkg - publishVstsFeed: $(AzDoFeedName) - - - task: PowerShell@2 - displayName: Publish Blobs to AzDO Feed - inputs: - filePath: $(Build.SourcesDirectory)/eng/common/post-build/publish-blobs-to-azdo.ps1 - arguments: -FeedName $(AzDoFeedName) - -SourceFolderCollection $(Build.ArtifactStagingDirectory)/BlobArtifacts/ - -PersonalAccessToken $(dn-bot-dnceng-unviersal-packages-rw) - enabled: false - - -- stage: PVR_PublishValidation - displayName: Publish Validation - variables: - - template: ../common-variables.yml - jobs: - - template: ../setup-maestro-vars.yml - - - template: ../darc-gather-drop.yml - parameters: - ChannelId: ${{ variables.PublicValidationRelease_30_Channel_Id }} + /p:NugetPath=$(NuGetExeToolPath) + /p:AzdoTargetFeedPAT='$(dn-bot-dnceng-universal-packages-rw)' + /p:AzureStorageTargetFeedPAT='$(dotnetfeed-storage-access-key-1)' + /p:BARBuildId=$(BARBuildId) + /p:MaestroApiEndpoint='$(MaestroApiEndPoint)' + /p:BuildAssetRegistryToken='$(MaestroApiAccessToken)' + /p:ManifestsBasePath='$(Build.ArtifactStagingDirectory)/AssetManifests/' + /p:BlobBasePath='$(Build.ArtifactStagingDirectory)/BlobArtifacts/' + /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts/' + /p:Configuration=Release + /p:PublishInstallersAndChecksums=${{ parameters.publishInstallersAndChecksums }} + /p:InstallersTargetStaticFeed=$(InstallersBlobFeedUrl) + /p:InstallersAzureAccountKey=$(dotnetcli-storage-key) + /p:ChecksumsTargetStaticFeed=$(ChecksumsBlobFeedUrl) + /p:ChecksumsAzureAccountKey=$(dotnetclichecksums-storage-key) + /p:PublishToAzureDevOpsNuGetFeeds=true + /p:AzureDevOpsStaticShippingFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools/nuget/v3/index.json' + /p:AzureDevOpsStaticShippingFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticTransportFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools/nuget/v3/index.json' + /p:AzureDevOpsStaticTransportFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + /p:AzureDevOpsStaticSymbolsFeed='https://pkgs.dev.azure.com/dnceng/public/_packaging/dotnet-tools-symbols/nuget/v3/index.json' + /p:AzureDevOpsStaticSymbolsFeedKey='$(dn-bot-dnceng-artifact-feeds-rw)' + ${{ parameters.artifactsPublishingAdditionalParameters }} - - template: ../promote-build.yml - parameters: - ChannelId: ${{ variables.PublicValidationRelease_30_Channel_Id }} + - template: ../../steps/promote-build.yml + parameters: + ChannelId: ${{ variables.PublicValidationRelease_30_Channel_Id }} diff --git a/eng/common/templates/post-build/common-variables.yml b/eng/common/templates/post-build/common-variables.yml index 52a74487fd..9ccc08b2c8 100644 --- a/eng/common/templates/post-build/common-variables.yml +++ b/eng/common/templates/post-build/common-variables.yml @@ -1,9 +1,11 @@ variables: - group: Publish-Build-Assets + - group: DotNet-DotNetCli-Storage + - group: DotNet-MSRC-Storage - # .NET Core 3 Dev - - name: PublicDevRelease_30_Channel_Id - value: 3 + # .NET Core 3.1 Dev + - name: PublicDevRelease_31_Channel_Id + value: 128 # .NET Core 5 Dev - name: NetCore_5_Dev_Channel_Id @@ -25,14 +27,14 @@ variables: - name: PublicRelease_30_Channel_Id value: 19 + # .NET Core 3.1 Release + - name: PublicRelease_31_Channel_Id + value: 129 + # Whether the build is internal or not - name: IsInternalBuild value: ${{ and(ne(variables['System.TeamProject'], 'public'), contains(variables['Build.SourceBranch'], 'internal')) }} - # Storage account name for proxy-backed feeds - - name: ProxyBackedFeedsAccountName - value: dotnetfeed - # Default Maestro++ API Endpoint and API Version - name: MaestroApiEndPoint value: "https://maestro-prod.westus2.cloudapp.azure.com" @@ -45,3 +47,24 @@ variables: value: 3.0.0 - name: SymbolToolVersion value: 1.0.1 + + # Feed Configurations + # These should include the suffix "/index.json" + + # Default locations for Installers and checksums + # Public Locations + - name: ChecksumsBlobFeedUrl + value: https://dotnetclichecksums.blob.core.windows.net/dotnet/index.json + - name: InstallersBlobFeedUrl + value: https://dotnetcli.blob.core.windows.net/dotnet/index.json + + # Private Locations + - name: InternalChecksumsBlobFeedUrl + value: https://dotnetclichecksumsmsrc.blob.core.windows.net/dotnet/index.json + - name: InternalChecksumsBlobFeedKey + value: $(dotnetclichecksumsmsrc-storage-key) + + - name: InternalInstallersBlobFeedUrl + value: https://dotnetclimsrc.blob.core.windows.net/dotnet/index.json + - name: InternalInstallersBlobFeedKey + value: $(dotnetclimsrc-access-key) diff --git a/eng/common/templates/post-build/post-build.yml b/eng/common/templates/post-build/post-build.yml index aba0b0fcaf..3f06b5d146 100644 --- a/eng/common/templates/post-build/post-build.yml +++ b/eng/common/templates/post-build/post-build.yml @@ -1,18 +1,29 @@ parameters: - enableSourceLinkValidation: true + enableSourceLinkValidation: false enableSigningValidation: true - enableSymbolValidation: true + enableSymbolValidation: false enableNugetValidation: true + publishInstallersAndChecksums: false SDLValidationParameters: enable: false + continueOnError: false params: '' + # These parameters let the user customize the call to sdk-task.ps1 for publishing + # symbols & general artifacts as well as for signing validation + symbolPublishingAdditionalParameters: '' + artifactsPublishingAdditionalParameters: '' + signingValidationAdditionalParameters: '' + # Which stages should finish execution before post-build stages start - dependsOn: [build] + validateDependsOn: + - build + publishDependsOn: + - Validate stages: -- stage: validate - dependsOn: ${{ parameters.dependsOn }} +- stage: Validate + dependsOn: ${{ parameters.validateDependsOn }} displayName: Validate jobs: - ${{ if eq(parameters.enableNugetValidation, 'true') }}: @@ -37,6 +48,9 @@ stages: - ${{ if eq(parameters.enableSigningValidation, 'true') }}: - job: displayName: Signing Validation + variables: + - template: common-variables.yml + - group: AzureDevOps-Artifact-Feeds-Pats pool: vmImage: 'windows-2019' steps: @@ -46,6 +60,19 @@ stages: buildType: current artifactName: PackageArtifacts + # This is necessary whenever we want to publish/restore to an AzDO private feed + # Since sdk-task.ps1 tries to restore packages we need to do this authentication here + # otherwise it'll complain about accessing a private feed. + - task: NuGetAuthenticate@0 + condition: eq(variables['IsInternalBuild'], 'true') + displayName: 'Authenticate to AzDO Feeds' + + - task: PowerShell@2 + displayName: Enable cross-org publishing + inputs: + filePath: eng\common\enable-cross-org-publishing.ps1 + arguments: -token $(dn-bot-dnceng-artifact-feeds-rw) + - task: PowerShell@2 displayName: Validate inputs: @@ -53,7 +80,8 @@ stages: arguments: -task SigningValidation -restore -msbuildEngine dotnet /p:PackageBasePath='$(Build.ArtifactStagingDirectory)/PackageArtifacts' /p:SignCheckExclusionsFile='$(Build.SourcesDirectory)/eng/SignCheckExclusionsFile.txt' - /p:Configuration=Release + /p:Configuration=Release + ${{ parameters.signingValidationAdditionalParameters }} - ${{ if eq(parameters.enableSourceLinkValidation, 'true') }}: - job: @@ -78,26 +106,57 @@ stages: -GHRepoName $(Build.Repository.Name) -GHCommit $(Build.SourceVersion) -SourcelinkCliVersion $(SourceLinkCLIVersion) + continueOnError: true - ${{ if eq(parameters.SDLValidationParameters.enable, 'true') }}: - template: /eng/common/templates/job/execute-sdl.yml parameters: additionalParameters: ${{ parameters.SDLValidationParameters.params }} + continueOnError: ${{ parameters.SDLValidationParameters.continueOnError }} - template: \eng\common\templates\post-build\channels\netcore-dev-5.yml parameters: - enableSymbolValidation: ${{ parameters.enableSymbolValidation }} + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} -- template: \eng\common\templates\post-build\channels\public-dev-release.yml +- template: \eng\common\templates\post-build\channels\netcore-dev-31.yml parameters: - enableSymbolValidation: ${{ parameters.enableSymbolValidation }} + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} - template: \eng\common\templates\post-build\channels\netcore-tools-latest.yml parameters: - enableSymbolValidation: ${{ parameters.enableSymbolValidation }} + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} - template: \eng\common\templates\post-build\channels\public-validation-release.yml + parameters: + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + +- template: \eng\common\templates\post-build\channels\netcore-release-30.yml + parameters: + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} -- template: \eng\common\templates\post-build\channels\public-release.yml +- template: \eng\common\templates\post-build\channels\netcore-release-31.yml + parameters: + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + publishInstallersAndChecksums: ${{ parameters.publishInstallersAndChecksums }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} -- template: \eng\common\templates\post-build\channels\internal-servicing.yml +- template: \eng\common\templates\post-build\channels\netcore-internal-30.yml + parameters: + artifactsPublishingAdditionalParameters: ${{ parameters.artifactsPublishingAdditionalParameters }} + dependsOn: ${{ parameters.publishDependsOn }} + symbolPublishingAdditionalParameters: ${{ parameters.symbolPublishingAdditionalParameters }} diff --git a/eng/common/templates/steps/promote-build.yml b/eng/common/templates/steps/promote-build.yml new file mode 100644 index 0000000000..b90404435d --- /dev/null +++ b/eng/common/templates/steps/promote-build.yml @@ -0,0 +1,13 @@ +parameters: + ChannelId: 0 + +steps: +- task: PowerShell@2 + displayName: Add Build to Channel + inputs: + filePath: $(Build.SourcesDirectory)/eng/common/post-build/promote-build.ps1 + arguments: -BuildId $(BARBuildId) + -ChannelId ${{ parameters.ChannelId }} + -MaestroApiAccessToken $(MaestroApiAccessToken) + -MaestroApiEndPoint $(MaestroApiEndPoint) + -MaestroApiVersion $(MaestroApiVersion) diff --git a/eng/common/tools.ps1 b/eng/common/tools.ps1 index 9c12b1b4fd..5c94bd78d6 100644 --- a/eng/common/tools.ps1 +++ b/eng/common/tools.ps1 @@ -153,6 +153,7 @@ function InitializeDotNetCli([bool]$install) { # Make Sure that our bootstrapped dotnet cli is available in future steps of the Azure Pipelines build Write-PipelinePrependPath -Path $dotnetRoot + Write-PipelineSetVariable -Name 'DOTNET_MULTILEVEL_LOOKUP' -Value '0' Write-PipelineSetVariable -Name 'DOTNET_SKIP_FIRST_TIME_EXPERIENCE' -Value '1' @@ -163,6 +164,7 @@ function GetDotNetInstallScript([string] $dotnetRoot) { $installScript = Join-Path $dotnetRoot "dotnet-install.ps1" if (!(Test-Path $installScript)) { Create-Directory $dotnetRoot + $ProgressPreference = 'SilentlyContinue' # Don't display the console progress UI - it's a huge perf hit Invoke-WebRequest "https://dot.net/$dotnetInstallScriptVersion/dotnet-install.ps1" -OutFile $installScript } @@ -282,6 +284,7 @@ function InitializeXCopyMSBuild([string]$packageVersion, [bool]$install) { Create-Directory $packageDir Write-Host "Downloading $packageName $packageVersion" + $ProgressPreference = 'SilentlyContinue' # Don't display the console progress UI - it's a huge perf hit Invoke-WebRequest "https://dotnet.myget.org/F/roslyn-tools/api/v2/package/$packageName/$packageVersion/" -OutFile $packagePath Unzip $packagePath $packageDir } @@ -363,7 +366,6 @@ function InitializeBuildTool() { Write-PipelineTelemetryError -Category "InitializeToolset" -Message "/global.json must specify 'tools.dotnet'." ExitWithExitCode 1 } - $buildTool = @{ Path = Join-Path $dotnetRoot "dotnet.exe"; Command = "msbuild"; Tool = "dotnet"; Framework = "netcoreapp2.1" } } elseif ($msbuildEngine -eq "vs") { try { @@ -488,6 +490,18 @@ function Stop-Processes() { function MSBuild() { if ($pipelinesLog) { $buildTool = InitializeBuildTool + + # Work around issues with Azure Artifacts credential provider + # https://github.com/dotnet/arcade/issues/3932 + if ($ci -and $buildTool.Tool -eq "dotnet") { + dotnet nuget locals http-cache -c + + $env:NUGET_PLUGIN_HANDSHAKE_TIMEOUT_IN_SECONDS = 20 + $env:NUGET_PLUGIN_REQUEST_TIMEOUT_IN_SECONDS = 20 + Write-PipelineSetVariable -Name 'NUGET_PLUGIN_HANDSHAKE_TIMEOUT_IN_SECONDS' -Value '20' + Write-PipelineSetVariable -Name 'NUGET_PLUGIN_REQUEST_TIMEOUT_IN_SECONDS' -Value '20' + } + $toolsetBuildProject = InitializeToolset $path = Split-Path -parent $toolsetBuildProject $path = Join-Path $path (Join-Path $buildTool.Framework "Microsoft.DotNet.Arcade.Sdk.dll") diff --git a/eng/common/tools.sh b/eng/common/tools.sh index 3af9be6157..93ee4d67e3 100755 --- a/eng/common/tools.sh +++ b/eng/common/tools.sh @@ -208,12 +208,19 @@ function GetDotNetInstallScript { # Use curl if available, otherwise use wget if command -v curl > /dev/null; then - curl "$install_script_url" -sSL --retry 10 --create-dirs -o "$install_script" - else - wget -q -O "$install_script" "$install_script_url" + curl "$install_script_url" -sSL --retry 10 --create-dirs -o "$install_script" || { + local exit_code=$? + Write-PipelineTelemetryError -category 'InitializeToolset' "Failed to acquire dotnet install script (exit code '$exit_code')." + ExitWithExitCode $exit_code + } + else + wget -q -O "$install_script" "$install_script_url" || { + local exit_code=$? + Write-PipelineTelemetryError -category 'InitializeToolset' "Failed to acquire dotnet install script (exit code '$exit_code')." + ExitWithExitCode $exit_code + } fi fi - # return value _GetDotNetInstallScript="$install_script" } @@ -321,6 +328,18 @@ function MSBuild { if [[ "$pipelines_log" == true ]]; then InitializeBuildTool InitializeToolset + + # Work around issues with Azure Artifacts credential provider + # https://github.com/dotnet/arcade/issues/3932 + if [[ "$ci" == true ]]; then + dotnet nuget locals http-cache -c + + export NUGET_PLUGIN_HANDSHAKE_TIMEOUT_IN_SECONDS=20 + export NUGET_PLUGIN_REQUEST_TIMEOUT_IN_SECONDS=20 + Write-PipelineSetVariable -name "NUGET_PLUGIN_HANDSHAKE_TIMEOUT_IN_SECONDS" -value "20" + Write-PipelineSetVariable -name "NUGET_PLUGIN_REQUEST_TIMEOUT_IN_SECONDS" -value "20" + fi + local toolset_dir="${_InitializeToolset%/*}" local logger_path="$toolset_dir/$_InitializeBuildToolFramework/Microsoft.DotNet.Arcade.Sdk.dll" args=( "${args[@]}" "-logger:$logger_path" ) diff --git a/eng/release/insert-into-vs.yml b/eng/release/insert-into-vs.yml new file mode 100644 index 0000000000..89650f190d --- /dev/null +++ b/eng/release/insert-into-vs.yml @@ -0,0 +1,54 @@ +parameters: + componentBranchName: '' + insertBuildPolicy: 'CloudBuild - Request RPS' + insertTargetBranch: '' + insertTeamEmail: '' + insertTeamName: '' + dependsOn: [build] + +stages: +- stage: insert + dependsOn: build + displayName: Insert into VS + jobs: + - job: Insert_VS + pool: + vmImage: vs2017-win2016 + variables: + - group: DotNet-VSTS-Infra-Access + - name: InsertAccessToken + value: $(dn-bot-devdiv-build-rw-code-rw-release-rw) + - name: InsertBuildPolicy + value: ${{ parameters.insertBuildPolicy }} + - name: InsertTargetBranch + value: ${{ parameters.insertTargetBranch }} + - name: InsertTeamEmail + value: ${{ parameters.insertTeamEmail }} + - name: InsertTeamName + value: ${{ parameters.insertTeamName }} + steps: + - task: DownloadBuildArtifacts@0 + displayName: Download Insertion Artifacts + inputs: + buildType: current + artifactName: VSSetup + - task: PowerShell@2 + displayName: Get Publish URLs + inputs: + filePath: $(Build.SourcesDirectory)/eng/release/scripts/GetPublishUrls.ps1 + arguments: -accessToken $(System.AccessToken) -buildId $(Build.BuildId) -insertionDir $(Build.ArtifactStagingDirectory)\VSSetup + - task: PowerShell@2 + displayName: Get versions for default.config + inputs: + filePath: $(Build.SourcesDirectory)/eng/release/scripts/GetDefaultConfigVersions.ps1 + arguments: -packagesDir $(Build.ArtifactStagingDirectory)\VSSetup\DevDivPackages + - task: PowerShell@2 + displayName: Get versions for AssemblyVersions.tt + inputs: + filePath: $(Build.SourcesDirectory)/eng/release/scripts/GetAssemblyVersions.ps1 + arguments: -assemblyVersionsPath $(Build.ArtifactStagingDirectory)\VSSetup\DevDivPackages\DependentAssemblyVersions.csv + - task: ms-vseng.MicroBuildShipTasks.55100717-a81d-45ea-a363-b8fe3ec375ad.MicroBuildInsertVsPayload@3 + displayName: 'Insert VS Payload' + inputs: + LinkWorkItemsToPR: false + condition: and(succeeded(), eq(variables['Build.SourceBranch'], '${{ parameters.componentBranchName }}')) diff --git a/eng/release/scripts/GetAssemblyVersions.ps1 b/eng/release/scripts/GetAssemblyVersions.ps1 new file mode 100644 index 0000000000..2b75ac1dd5 --- /dev/null +++ b/eng/release/scripts/GetAssemblyVersions.ps1 @@ -0,0 +1,28 @@ +[CmdletBinding(PositionalBinding=$false)] +param ( + [string]$assemblyVersionsPath +) + +Set-StrictMode -version 2.0 +$ErrorActionPreference = "Stop" + +try { + [string[]]$lines = Get-Content -Path $assemblyVersionsPath | ForEach-Object { + $parts = $_ -Split ",",2 + $asm = $parts[0] + $ver = $parts[1] + $asmConst = ($asm -Replace "\.","") + "Version" + $output = "$asmConst=$ver" + $output + } + + $final = $lines -Join "," + Write-Host "Setting InsertVersionsValues to $final" + Write-Host "##vso[task.setvariable variable=InsertVersionsValues]$final" +} +catch { + Write-Host $_ + Write-Host $_.Exception + Write-Host $_.ScriptStackTrace + exit 1 +} diff --git a/eng/release/scripts/GetDefaultConfigVersions.ps1 b/eng/release/scripts/GetDefaultConfigVersions.ps1 new file mode 100644 index 0000000000..d0f1f67fc5 --- /dev/null +++ b/eng/release/scripts/GetDefaultConfigVersions.ps1 @@ -0,0 +1,29 @@ +[CmdletBinding(PositionalBinding=$false)] +param ( + [string]$packagesDir +) + +Set-StrictMode -version 2.0 +$ErrorActionPreference = "Stop" + +try { + $packages = @() + $regex = "^(.*?)\.((?:\.?[0-9]+){3,}(?:[-a-z0-9]+)?)\.nupkg$" + Get-Item -Path "$packagesDir\*" -Filter "*.nupkg" | ForEach-Object { + $fileName = Split-Path $_ -Leaf + If ($fileName -Match $regex) { + $entry = $Matches[1] + "=" + $Matches[2] + $packages += $entry + } + } + + $final = $packages -Join "," + Write-Host "Setting InsertConfigValues to $final" + Write-Host "##vso[task.setvariable variable=InsertConfigValues]$final" +} +catch { + Write-Host $_ + Write-Host $_.Exception + Write-Host $_.ScriptStackTrace + exit 1 +} diff --git a/eng/release/scripts/GetPublishUrls.ps1 b/eng/release/scripts/GetPublishUrls.ps1 new file mode 100644 index 0000000000..758c20ea51 --- /dev/null +++ b/eng/release/scripts/GetPublishUrls.ps1 @@ -0,0 +1,57 @@ +[CmdletBinding(PositionalBinding=$false)] +param ( + [string]$accessToken, + [string]$buildId, + [string]$insertionDir +) + +Set-StrictMode -version 2.0 +$ErrorActionPreference = "Stop" + +try { + # build map of all *.vsman files to their `info.buildVersion` values + $manifestVersionMap = @{} + Get-ChildItem -Path "$insertionDir\*" -Filter "*.vsman" | ForEach-Object { + $manifestName = Split-Path $_ -Leaf + $vsmanContents = Get-Content $_ | ConvertFrom-Json + $buildVersion = $vsmanContents.info.buildVersion + $manifestVersionMap.Add($manifestName, $buildVersion) + } + + # find all publish URLs + $manifests = @() + $seenManifests = @{} + $url = "https://dev.azure.com/dnceng/internal/_apis/build/builds/$buildId/logs?api-version=5.1" + $base64 = [Convert]::ToBase64String([System.Text.Encoding]::ASCII.GetBytes(":$accessToken")) + $headers = @{ + Authorization = "Basic $base64" + } + Write-Host "Fetching log from $url" + $json = Invoke-WebRequest -Method Get -Uri $url -Headers $headers -UseBasicParsing | ConvertFrom-Json + foreach ($l in $json.value) { + $logUrl = $l.url + Write-Host "Fetching log from $logUrl" + $log = (Invoke-WebRequest -Method Get -Uri $logUrl -Headers $headers -UseBasicParsing).Content + If ($log -Match "(https://vsdrop\.corp\.microsoft\.com/[^\r\n;]+);([^\r\n]+)\r?\n") { + $manifestShortUrl = $Matches[1] + $manifestName = $Matches[2] + $manifestUrl = "$manifestShortUrl;$manifestName" + If (-Not $seenManifests.Contains($manifestUrl)) { + $seenManifests.Add($manifestUrl, $true) + $buildVersion = $manifestVersionMap[$manifestName] + $manifestEntry = "$manifestName{$buildVersion}=$manifestUrl" + $manifests += $manifestEntry + } + } + } + + $final = $manifests -Join "," + Write-Host "Setting InsertJsonValues to $final" + Write-Host "##vso[task.setvariable variable=InsertJsonValues]$final" +} +catch { + Write-Host $_ + Write-Host $_.Exception + Write-Host $_.ScriptStackTrace + exit 1 +} 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 56ba4a9f09..fbc1e3f281 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 @@ -13,10 +13,11 @@ 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 + logo.png F#, compiler, msbuild + Service/MSBuildReferenceResolver.fs 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 c330227567..5f5d169797 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj +++ b/fcs/FSharp.Compiler.Service.ProjectCracker/FSharp.Compiler.Service.ProjectCracker.fsproj @@ -11,10 +11,11 @@ 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 + logo.png F#, compiler, msbuild + ProjectCrackerOptions.fs 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 448fdd6260..7f0522e8e3 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -14,14 +14,10 @@ true - $(DefineConstants);FX_NO_RUNTIMEENVIRONMENT $(DefineConstants);NO_PROJECTCRACKER $(DefineConstants);FCS - - ReshapedReflection.fs - FsUnit.fs diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 55b2ad535e..f519ba3462 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -28,21 +28,20 @@ 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 + logo.png F#, fsharp, interactive, compiler, editor $(DefineConstants);FX_NO_PDB_READER $(DefineConstants);FX_NO_PDB_WRITER $(DefineConstants);FX_NO_SYMBOLSTORE - $(DefineConstants);FX_NO_LINKEDRESOURCES $(DefineConstants);FX_NO_APP_DOMAINS - $(DefineConstants);FX_NO_RUNTIMEENVIRONMENT $(DefineConstants);FX_NO_WIN_REGISTRY $(DefineConstants);FX_NO_SYSTEM_CONFIGURATION $(DefineConstants);FX_RESHAPED_REFEMIT + AssemblyInfo/AssemblyInfo.fs @@ -70,9 +69,6 @@ Logger.fs - - Reshaped/reshapedreflection.fs - ErrorText/sformat.fsi @@ -85,6 +81,12 @@ ErrorText/sr.fs + + Driver\LanguageFeatures.fsi + + + Driver\LanguageFeatures.fs + LexYaccRuntime/prim-lexing.fsi @@ -160,6 +162,9 @@ Utilities/bytes.fs + + Utilities\XmlAdapters.fs + Utilities/lib.fs @@ -228,6 +233,12 @@ + + AbsIL/ilnativeres.fsi + + + AbsIL/ilnativeres.fs + AbsIL/ilsupp.fsi @@ -267,6 +278,9 @@ AbsIL/ilreflect.fs + + ReferenceResolution/reshapedmsbuild.fs + ReferenceResolution/ReferenceResolver.fs @@ -591,9 +605,6 @@ Service/ServiceUntypedParse.fs - - Service/reshapedmsbuild.fs - Service/ServiceDeclarationLists.fsi diff --git a/fcs/README.md b/fcs/README.md index b85678d58c..33f5989094 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -62,9 +62,9 @@ which does things like: You can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.28.0.0.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.28.0.0.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.28.0.0.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.32.0.0.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.32.0.0.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.32.0.0.nupkg %APIKEY% -Source https://nuget.org ### Use of Paket and FAKE @@ -99,5 +99,5 @@ FSharp.Compiler.Service is a somewhat awkward component. There are some things w 1. Remove the use of Paket and FAKE 1. Move all projects under fcs\... to new .NET SDK project file format 1. Drop the use of ``dotnet mergenupkg`` since we should be able to use cross targeting -1. Make FCS a DLL similar ot the rest of the build and make this an official component from Microsoft (signed etc.) +1. Make FCS a DLL similar to the rest of the build and make this an official component from Microsoft (signed etc.) 1. Replace FSharp.Compiler.Private by FSharp.Compiler.Service diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index 73164bb892..f299ca9902 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,14 @@ +#### 32.0.0 + +* integrate dotnet/fsharp from e1b8537ee to 48f932cf8 +* notable changes include: + * (preview) nameof + * (preview) open static classes + * Fixed 64-bit integer literal parsing + * Better exhaustiveness checking for byte and sbyte pattern matches + * Better native resource handling + * Script-host assembly load events + #### 31.0.0 * Integrate dotnet/fsharp from 5a8f454a1 to 05c558a61 * Notable changes include: diff --git a/fcs/docsrc/content/caches.fsx b/fcs/docsrc/content/caches.fsx index a0a198896c..2f63c4b394 100644 --- a/fcs/docsrc/content/caches.fsx +++ b/fcs/docsrc/content/caches.fsx @@ -9,7 +9,7 @@ This is a design note on the FSharpChecker component and its caches. See also t Each FSharpChecker object maintains a set of caches. These are * ``scriptClosureCache`` - an MRU cache of default size ``projectCacheSize`` that caches the - computation of GetProjectOptionsFromScript. This computation can be lengthy as it can involve processing the transative closure + computation of GetProjectOptionsFromScript. This computation can be lengthy as it can involve processing the transitive closure of all ``#load`` directives, which in turn can mean parsing an unbounded number of script files * ``incrementalBuildersCache`` - an MRU cache of projects where a handle is being kept to their incremental checking state, @@ -50,7 +50,7 @@ The sizes of some of these caches can be adjusted by giving parameters to FSharp the cache sizes above indicate the "strong" size of the cache, where memory is held regardless of the memory pressure on the system. Some of the caches can also hold "weak" references which can be collected at will by the GC. -> Note: Because of these caches, uou should generally use one global, shared FSharpChecker for everything in an IDE application. +> Note: Because of these caches, you should generally use one global, shared FSharpChecker for everything in an IDE application. Low-Memory Condition diff --git a/fcs/docsrc/content/compiler.fsx b/fcs/docsrc/content/compiler.fsx index c87f755ed3..a7e5303a06 100644 --- a/fcs/docsrc/content/compiler.fsx +++ b/fcs/docsrc/content/compiler.fsx @@ -85,14 +85,14 @@ is not really an option. You still have to pass the "-o" option to name the output file, but the output file is not actually written to disk. -The 'None' option indicates that the initiatlization code for the assembly is not executed. +The 'None' option indicates that the initialization code for the assembly is not executed. *) let errors2, exitCode2, dynAssembly2 = checker.CompileToDynamicAssembly([| "-o"; fn3; "-a"; fn2 |], execute=None) |> Async.RunSynchronously (* -Passing 'Some' for the 'execute' parameter executes the initiatlization code for the assembly. +Passing 'Some' for the 'execute' parameter executes the initialization code for the assembly. *) let errors3, exitCode3, dynAssembly3 = checker.CompileToDynamicAssembly([| "-o"; fn3; "-a"; fn2 |], Some(stdout,stderr)) diff --git a/fcs/docsrc/content/devnotes.md b/fcs/docsrc/content/devnotes.md index d086b57796..7f80660f36 100644 --- a/fcs/docsrc/content/devnotes.md +++ b/fcs/docsrc/content/devnotes.md @@ -20,7 +20,7 @@ This repo should be _identical_ to 'fsharp' except: - No bootstrap or proto compiler is used - an installed F# compiler is assumed - Build script using FAKE that builds everything, produces NuGet package and - generates documentation, files for publising NuGet packages etc. + generates documentation, files for publishing NuGet packages etc. (following [F# project scaffold](https://github.com/fsprojects/FSharp.ProjectScaffold)) - Changes to compiler source code to expose new functionality; Changes to the @@ -30,7 +30,7 @@ This repo should be _identical_ to 'fsharp' except: - Additions to compiler source code which add new functionality to the compiler service API -If language or compiler addiitons are committed to `fsharp/fsharp`, they should be merged into +If language or compiler additions are committed to `fsharp/fsharp`, they should be merged into this repo and a new NuGet package released. ## Building and NuGet diff --git a/fcs/docsrc/content/editor.fsx b/fcs/docsrc/content/editor.fsx index b8af9d0117..46ddd882e5 100644 --- a/fcs/docsrc/content/editor.fsx +++ b/fcs/docsrc/content/editor.fsx @@ -27,6 +27,7 @@ of `InteractiveChecker`: open System open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Text // Create an interactive checker instance let checker = FSharpChecker.Create() @@ -53,7 +54,7 @@ let inputLines = input.Split('\n') let file = "/home/user/Test.fsx" let projOptions, errors = - checker.GetProjectOptionsFromScript(file, input) + checker.GetProjectOptionsFromScript(file, SourceText.ofString input) |> Async.RunSynchronously let parsingOptions, _errors = checker.GetParsingOptionsFromProjectOptions(projOptions) @@ -68,7 +69,7 @@ together. // Perform parsing let parseFileResults = - checker.ParseFile(file, input, parsingOptions) + checker.ParseFile(file, SourceText.ofString input, parsingOptions) |> Async.RunSynchronously (** Before we look at the interesting operations provided by `TypeCheckResults`, we @@ -78,7 +79,7 @@ result (but it may contain incorrectly "guessed" results). // Perform type checking let checkFileAnswer = - checker.CheckFileInProject(parseFileResults, file, 0, input, projOptions) + checker.CheckFileInProject(parseFileResults, file, 0, SourceText.ofString input, projOptions) |> Async.RunSynchronously (** @@ -86,7 +87,7 @@ Alternatively you can use `ParseAndCheckFileInProject` to check both in one step *) let parseResults2, checkFileAnswer2 = - checker.ParseAndCheckFileInProject(file, 0, input, projOptions) + checker.ParseAndCheckFileInProject(file, 0, SourceText.ofString input, projOptions) |> Async.RunSynchronously (** @@ -159,7 +160,7 @@ list of members of the string value `msg`. To do this, we call `GetDeclarationListInfo` with the location of the `.` symbol on the last line (ending with `printfn "%s" msg.`). The offsets are one-based, so the location is `7, 23`. -We also need to specify a function that says that the text has not changed and the current identifer +We also need to specify a function that says that the text has not changed and the current identifier where we need to perform the completion. *) // Get declarations (autocomplete) for a location diff --git a/fcs/docsrc/content/interactive.fsx b/fcs/docsrc/content/interactive.fsx index 2854d4529e..6226bcbee1 100644 --- a/fcs/docsrc/content/interactive.fsx +++ b/fcs/docsrc/content/interactive.fsx @@ -43,7 +43,7 @@ open System open System.IO open System.Text -// Intialize output and input streams +// Initialize output and input streams let sbOut = new StringBuilder() let sbErr = new StringBuilder() let inStream = new StringReader("") @@ -121,7 +121,7 @@ result and an exception. The result part of ``EvalExpression`` and ``EvalExpressionNonThrowing`` is an optional ``FSharpValue``. If that value is not present then it just indicates that the expression didn't have a tangible -result that could be represented as a .NET object. This siutation shouldn't actually +result that could be represented as a .NET object. This situation shouldn't actually occur for any normal input expressions, and only for primitives used in libraries. *) @@ -239,10 +239,10 @@ The 'fsi' object ------------------ If you want your scripting code to be able to access the 'fsi' object, you should pass in an implementation of this object explicitly. -Normally the one fromm FSharp.Compiler.Interactive.Settings.dll is used. +Normally the one from FSharp.Compiler.Interactive.Settings.dll is used. *) -let fsiConfig2 = FsiEvaluationSession.GetDefaultConfiguration(fsi) +let fsiConfig2 = FsiEvaluationSession.GetDefaultConfiguration(fsiSession) (** Collectible code generation diff --git a/fcs/docsrc/content/project.fsx b/fcs/docsrc/content/project.fsx index 72bf7993f4..a537000435 100644 --- a/fcs/docsrc/content/project.fsx +++ b/fcs/docsrc/content/project.fsx @@ -28,6 +28,7 @@ of `InteractiveChecker`: open System open System.Collections.Generic open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Text // Create an interactive checker instance let checker = FSharpChecker.Create() @@ -220,7 +221,7 @@ in the project are still read from disk, unless you are using the [FileSystem AP *) let parseResults1, checkAnswer1 = - checker.ParseAndCheckFileInProject(Inputs.fileName1, 0, Inputs.fileSource1, projectOptions) + checker.ParseAndCheckFileInProject(Inputs.fileName1, 0, SourceText.ofString Inputs.fileSource1, projectOptions) |> Async.RunSynchronously let checkResults1 = @@ -229,7 +230,7 @@ let checkResults1 = | _ -> failwith "unexpected aborted" let parseResults2, checkAnswer2 = - checker.ParseAndCheckFileInProject(Inputs.fileName2, 0, Inputs.fileSource2, projectOptions) + checker.ParseAndCheckFileInProject(Inputs.fileName2, 0, SourceText.ofString Inputs.fileSource2, projectOptions) |> Async.RunSynchronously let checkResults2 = @@ -313,7 +314,7 @@ F# projects normally use the '.fsproj' project file format. A project cracking facility for legacy old-style .fsproj is provided as a separate NuGet package: FSharp.Compiler.Service.ProjectCracker. -Projecet cracking for modern project files should be done using a library such as DotNetProjInfo. +Project cracking for modern project files should be done using a library such as DotNetProjInfo. See FsAutoComplete for example code. The legacy NuGet package `FSharp.Compiler.Service.ProjectCracker` contains a diff --git a/fcs/docsrc/content/queue.fsx b/fcs/docsrc/content/queue.fsx index ccc7ccabbf..7cf14a7b70 100644 --- a/fcs/docsrc/content/queue.fsx +++ b/fcs/docsrc/content/queue.fsx @@ -36,7 +36,7 @@ These use cross-threaded access to the TAST data produced by other FSharpChecker Some tools throw a lot of interactive work at the FSharpChecker operations queue. If you are writing such a component, consider running your project against a debug build of FSharp.Compiler.Service.dll to see the Trace.WriteInformation messages indicating the length of the -operations queuea and the time to process requests. +operations queue and the time to process requests. For those writing interactive editors which use FCS, you should be cautious about operations that request a check of the entire project. diff --git a/fcs/docsrc/content/react.fsx b/fcs/docsrc/content/react.fsx index ef5ccbf495..be108b92ad 100644 --- a/fcs/docsrc/content/react.fsx +++ b/fcs/docsrc/content/react.fsx @@ -67,7 +67,7 @@ If your host happens to be Visual Studio, then this is one technique you can use ... - // Unadvise file changes... + // Unadvised file changes... Com.ThrowOnFailure0(vsFileWatch.UnadviseFileChange(cookie)) diff --git a/fcs/docsrc/content/symbols.fsx b/fcs/docsrc/content/symbols.fsx index 74701e8b73..ab6b4657dc 100644 --- a/fcs/docsrc/content/symbols.fsx +++ b/fcs/docsrc/content/symbols.fsx @@ -19,6 +19,7 @@ of `FSharpChecker`: open System open System.IO open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Text // Create an interactive checker instance let checker = FSharpChecker.Create() @@ -72,7 +73,7 @@ type C() = member x.P = 1 """ let parseFileResults, checkFileResults = - parseAndTypeCheckSingleFile(file, input2) + parseAndTypeCheckSingleFile(file, SourceText.ofString input2) (** Now get the partial assembly signature for the code: @@ -100,7 +101,7 @@ Now get the value that corresponds to the function defined in the code: let fnVal = moduleEntity.MembersFunctionsAndValues.[0] (** -Now look around at the properties describing the function value. All fo the following evaluate to `true`: +Now look around at the properties describing the function value. All of the following evaluate to `true`: *) fnVal.Attributes.Count = 1 fnVal.CurriedParameterGroups.Count // 1 @@ -177,9 +178,9 @@ for assembly in projectContext.GetReferencedAssemblies() do (** **Notes:** - - If incomplete code is present, some or all of the attirbutes may not be quite as expected. + - If incomplete code is present, some or all of the attributes may not be quite as expected. - If some assembly references are missing (which is actually very, very common), then 'IsUnresolved' may - be true on values, members and/or entites related to external assemblies. You should be sure to make your + be true on values, members and/or entities related to external assemblies. You should be sure to make your code robust against IsUnresolved exceptions. *) diff --git a/fcs/docsrc/content/tokenizer.fsx b/fcs/docsrc/content/tokenizer.fsx index 7a46a3c91f..93a1dd3bf1 100644 --- a/fcs/docsrc/content/tokenizer.fsx +++ b/fcs/docsrc/content/tokenizer.fsx @@ -49,7 +49,7 @@ on the `FSharpSourceTokenizer` object that we created earlier: let tokenizer = sourceTok.CreateLineTokenizer("let answer=42") (** Now, we can write a simple recursive function that calls `ScanToken` on the `tokenizer` -until it returns `None` (indicating the end of line). When the function suceeds, it +until it returns `None` (indicating the end of line). When the function succeeds, it returns `FSharpTokenInfo` object with all the interesting details: *) /// Tokenize a single line of F# code diff --git a/fcs/docsrc/content/typedtree.fsx b/fcs/docsrc/content/typedtree.fsx index 500dc5fd24..f373cc2395 100644 --- a/fcs/docsrc/content/typedtree.fsx +++ b/fcs/docsrc/content/typedtree.fsx @@ -26,6 +26,7 @@ To use the interactive checker, reference `FSharp.Compiler.Service.dll` and open open System open System.IO open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Text (** ### Checking code @@ -42,7 +43,7 @@ let parseAndCheckSingleFile (input) = File.WriteAllText(file, input) // Get context representing a stand-alone (script) file let projOptions, _errors = - checker.GetProjectOptionsFromScript(file, input) + checker.GetProjectOptionsFromScript(file, SourceText.ofString input) |> Async.RunSynchronously let fprojOptions, _ = projOptions diff --git a/fcs/docsrc/content/untypedtree.fsx b/fcs/docsrc/content/untypedtree.fsx index 959e14fb94..162fedfa19 100644 --- a/fcs/docsrc/content/untypedtree.fsx +++ b/fcs/docsrc/content/untypedtree.fsx @@ -31,6 +31,7 @@ To use the interactive checker, reference `FSharp.Compiler.Service.dll` and open #r "FSharp.Compiler.Service.dll" open System open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.Text (** ### Performing untyped parse @@ -154,7 +155,7 @@ be another source of calls to `visitExpression`. ### Walking over declarations As mentioned earlier, the AST of a file contains a number of module or namespace declarations -(top-level node) that contain declarations inside a module (let bindings or types) or inisde +(top-level node) that contain declarations inside a module (let bindings or types) or inside a namespace (just types). The following functions walks over declarations - we ignore types, nested modules and all other elements and look only at top-level `let` bindings (values and functions): @@ -201,16 +202,19 @@ with location of the file. The location does not have to exist (it is used only information) and it can be in both Unix and Windows formats: *) // Sample input for the compiler service -let input = """ +let input = + """ let foo() = let msg = "Hello world" if true then - printfn "%s" msg """ + printfn "%s" msg + """ + // File name in Unix format let file = "/home/user/Test.fsx" // Get the AST of sample F# code -let tree = getUntypedTree(file, input) +let tree = getUntypedTree(file, SourceText.ofString input) (** When you run the code in F# interactive, you can enter `tree;;` in the interactive console and see pretty printed representation of the data structure - the tree contains a lot of information, diff --git a/fcs/docsrc/tools/generate.fsx b/fcs/docsrc/tools/generate.fsx index 617a154efb..c5f7589b23 100644 --- a/fcs/docsrc/tools/generate.fsx +++ b/fcs/docsrc/tools/generate.fsx @@ -28,6 +28,7 @@ open System.IO open Fake.FileHelper open FSharp.Literate open FSharp.MetadataFormat +open FSharp.Formatting.Razor let root = "." @@ -60,7 +61,7 @@ let fsfmt = __SOURCE_DIRECTORY__ @@ ".." @@ ".." @@ @"packages" @@ "FSharp.Form let buildReference () = CleanDir (output @@ "reference") for lib in referenceBinaries do - MetadataFormat.Generate + RazorMetadataFormat.Generate ( bin @@ lib, output @@ "reference", layoutRoots, parameters = ("root", root)::info, sourceRepo = "https://github.com/fsharp/FSharp.Compiler.Service/tree/master/src", @@ -87,7 +88,7 @@ let buildReference () = let buildDocumentation () = for dir in [content] do let sub = if dir.Length > content.Length then dir.Substring(content.Length + 1) else "." - Literate.ProcessDirectory + RazorLiterate.ProcessDirectory ( dir, docTemplate, output @@ sub, replacements = ("root", root)::info, layoutRoots = layoutRoots, generateAnchors = true, processRecursive=false ) diff --git a/global.json b/global.json index 42b7fded08..e8c93c341d 100644 --- a/global.json +++ b/global.json @@ -1,6 +1,6 @@ { "tools": { - "dotnet": "3.0.100-preview6-012264", + "dotnet": "3.0.100", "vs": { "version": "16.1", "components": [ @@ -10,7 +10,7 @@ } }, "msbuild-sdks": { - "Microsoft.DotNet.Arcade.Sdk": "1.0.0-beta.19410.2", + "Microsoft.DotNet.Arcade.Sdk": "5.0.0-beta.19476.6", "Microsoft.DotNet.Helix.Sdk": "2.0.0-beta.19069.2" } } diff --git a/src/absil/il.fs b/src/absil/il.fs index 4da728ac0b..75d30e6b79 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -2133,26 +2133,33 @@ and [] ILTypeDefs(f : unit -> ILPreTypeDef[]) = let ns, n = splitILTypeName nm dict.Value.[(ns, n)].GetTypeDef() + +and [] ILPreTypeDef = + abstract Namespace: string list + abstract Name: string + abstract GetTypeDef: unit -> ILTypeDef + + /// This is a memory-critical class. Very many of these objects get allocated and held to represent the contents of .NET assemblies. -and [] ILPreTypeDef(nameSpace: string list, name: string, metadataIndex: int32, storage: ILTypeDefStored) = +and [] ILPreTypeDefImpl(nameSpace: string list, name: string, metadataIndex: int32, storage: ILTypeDefStored) = let mutable store : ILTypeDef = Unchecked.defaultof<_> - member __.Namespace = nameSpace - member __.Name = name - member __.MetadataIndex = metadataIndex + interface ILPreTypeDef with + member __.Namespace = nameSpace + member __.Name = name - member x.GetTypeDef() = - match box store with - | null -> - match storage with - | ILTypeDefStored.Given td -> - store <- td - td - | ILTypeDefStored.Computed f -> - LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f())) - | ILTypeDefStored.Reader f -> - LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f x.MetadataIndex)) - | _ -> store + member x.GetTypeDef() = + match box store with + | null -> + match storage with + | ILTypeDefStored.Given td -> + store <- td + td + | ILTypeDefStored.Computed f -> + LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f())) + | ILTypeDefStored.Reader f -> + LazyInitializer.EnsureInitialized(&store, Func<_>(fun () -> f metadataIndex)) + | _ -> store and ILTypeDefStored = | Given of ILTypeDef @@ -2491,11 +2498,11 @@ let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = let mkILPreTypeDef (td: ILTypeDef) = let ns, n = splitILTypeName td.Name - ILPreTypeDef (ns, n, NoMetadataIdx, ILTypeDefStored.Given td) + ILPreTypeDefImpl (ns, n, NoMetadataIdx, ILTypeDefStored.Given td) :> ILPreTypeDef let mkILPreTypeDefComputed (ns, n, f) = - ILPreTypeDef (ns, n, NoMetadataIdx, ILTypeDefStored.Computed f) + ILPreTypeDefImpl (ns, n, NoMetadataIdx, ILTypeDefStored.Computed f) :> ILPreTypeDef let mkILPreTypeDefRead (ns, n, idx, f) = - ILPreTypeDef (ns, n, idx, f) + ILPreTypeDefImpl (ns, n, idx, f) :> ILPreTypeDef let addILTypeDef td (tdefs: ILTypeDefs) = ILTypeDefs (fun () -> [| yield mkILPreTypeDef td; yield! tdefs.AsArrayOfPreTypeDefs |]) diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 87fd66932a..e981e8e8b5 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1322,12 +1322,16 @@ and [] /// The information is enough to perform name resolution for the F# compiler, probe attributes /// for ExtensionAttribute etc. This is key to the on-demand exploration of .NET metadata. /// This information has to be "Goldilocks" - not too much, not too little, just right. -and [] ILPreTypeDef = - member Namespace: string list - member Name: string - member MetadataIndex: int32 +and [] ILPreTypeDef = + abstract Namespace: string list + abstract Name: string /// Realise the actual full typedef - member GetTypeDef : unit -> ILTypeDef + abstract GetTypeDef : unit -> ILTypeDef + + +and [] ILPreTypeDefImpl = + interface ILPreTypeDef + and [] ILTypeDefStored diff --git a/src/absil/illib.fs b/src/absil/illib.fs index fea0fd92a9..68b7c8d40a 100755 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -12,10 +12,6 @@ open System.Reflection open System.Threading open System.Runtime.CompilerServices -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - // Logical shift right treating int32 as unsigned integer. // Code that uses this should probably be adjusted to use unsigned integer types. let (>>>&) (x: int32) (n: int32) = int32 (uint32 x >>> n) @@ -258,12 +254,6 @@ module Option = module List = - //let item n xs = List.nth xs n -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - let sortWithOrder (c: IComparer<'T>) elements = List.sortWith (Order.toFunction c) elements let splitAfter n l = @@ -1272,11 +1262,6 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co [] module Shim = -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - type IFileSystem = /// A shim over File.ReadAllBytes diff --git a/src/absil/ilnativeres.fs b/src/absil/ilnativeres.fs new file mode 100644 index 0000000000..7b54df1e6f --- /dev/null +++ b/src/absil/ilnativeres.fs @@ -0,0 +1,918 @@ +// Quite literal port of : +// https://github.com/dotnet/roslyn/blob/fab7134296816fc80019c60b0f5bef7400cf23ea/src/Compilers/Core/Portable/PEWriter/NativeResourceWriter.cs +// And https://github.com/dotnet/roslyn/blob/d36121da4b527ee0617e4b0940b9d0b17b584470/src/Compilers/Core/Portable/CvtRes.cs +// And their dependencies (some classes) + +module internal FSharp.Compiler.AbstractIL.Internal.NativeRes + +open System +open System.Collections.Generic +open System.Diagnostics +open System.IO +open System.Linq +open System.Reflection.Metadata +open System.Reflection.PortableExecutable +open System.Runtime.CompilerServices +open System.Text + +open Checked + +type BYTE = System.Byte +type DWORD = System.UInt32 +type WCHAR = System.Char +type WORD = System.UInt16 + +let inline WORD s = uint16 s +let inline DWORD s = uint32 s +let inline WCHAR s = char s +let inline BYTE s = byte s + +type ResourceException(name: string, ?inner: Exception) = + inherit Exception (name, Option.toObj inner) + +type RESOURCE_STRING () = + member val Ordinal = Unchecked.defaultof with get, set + member val theString = Unchecked.defaultof with get, set + +type RESOURCE () = + member val pstringType = Unchecked.defaultof with get, set + member val pstringName = Unchecked.defaultof with get, set + member val DataSize = Unchecked.defaultof with get, set + member val HeaderSize = Unchecked.defaultof with get, set + member val DataVersion = Unchecked.defaultof with get, set + member val MemoryFlags = Unchecked.defaultof with get, set + member val LanguageId = Unchecked.defaultof with get, set + member val Version = Unchecked.defaultof with get, set + member val Characteristics = Unchecked.defaultof with get, set + member val data = Unchecked.defaultof with get, set + +type CvtResFile () = + static member val private RT_DLGINCLUDE = 17 with get, set + + static member ReadResFile (stream: Stream) = + let mutable reader = new BinaryReader (stream, Encoding.Unicode) + let mutable resourceNames = new List() + + // The stream might be empty, so let's check + if not (reader.PeekChar () = -1) then + let mutable startPos = stream.Position + let mutable initial32Bits = reader.ReadUInt32 () + if initial32Bits <> uint32 0 then + raise <| ResourceException(FSComp.SR.nativeResourceFormatError()) + stream.Position <- startPos + while (stream.Position < stream.Length) do + let mutable cbData = reader.ReadUInt32 () + let mutable cbHdr = reader.ReadUInt32 () + if cbHdr < 2u * uint32 sizeof then + // TODO: + // Current FSComp.txt converter doesn't yet support %x and %lx so format it as a string + // Because the lkg build is out of our control, will need to do it this way until + // The conversion fix flows through to the lkg + let msg = String.Format("0x{0:x}", stream.Position - 8L) + raise <| ResourceException(FSComp.SR.nativeResourceHeaderMalformed msg) + if cbData = 0u then + stream.Position <- stream.Position + int64 cbHdr - 2L * int64 sizeof + else + let mutable pAdditional = RESOURCE() + pAdditional.HeaderSize <- cbHdr + pAdditional.DataSize <- cbData + pAdditional.pstringType <- CvtResFile.ReadStringOrID (reader) + pAdditional.pstringName <- CvtResFile.ReadStringOrID (reader) + stream.Position <- stream.Position + 3L &&& ~~~3L + pAdditional.DataVersion <- reader.ReadUInt32 () + pAdditional.MemoryFlags <- reader.ReadUInt16 () + pAdditional.LanguageId <- reader.ReadUInt16 () + pAdditional.Version <- reader.ReadUInt32 () + pAdditional.Characteristics <- reader.ReadUInt32 () + pAdditional.data <- Array.zeroCreate (int pAdditional.DataSize) + reader.Read (pAdditional.data, 0, pAdditional.data.Length) |> ignore + stream.Position <- stream.Position + 3L &&& ~~~3L + if pAdditional.pstringType.theString = Unchecked.defaultof<_> && (pAdditional.pstringType.Ordinal = uint16 CvtResFile.RT_DLGINCLUDE) then + () (* ERROR ContinueNotSupported *) + else + resourceNames.Add (pAdditional) + resourceNames + + static member private ReadStringOrID (fhIn: BinaryReader) = + let mutable (pstring: RESOURCE_STRING) = RESOURCE_STRING () + let mutable (firstWord: WCHAR) = (fhIn.ReadChar ()) + if int firstWord = 0xFFFF then + pstring.Ordinal <- fhIn.ReadUInt16 () + else + pstring.Ordinal <- uint16 0xFFFF + let mutable (sb: StringBuilder) = StringBuilder () + let mutable (curChar: WCHAR) = firstWord + while (curChar <> char 0) do + sb.Append(curChar) |> ignore + curChar <- fhIn.ReadChar () + pstring.theString <- sb.ToString () + pstring + + +[] +type SectionCharacteristics = + | TypeReg = 0u + | TypeDSect = 1u + | TypeNoLoad = 2u + | TypeGroup = 4u + | TypeNoPad = 8u + | TypeCopy = 16u + | ContainsCode = 32u + | ContainsInitializedData = 64u + | ContainsUninitializedData = 128u + | LinkerOther = 256u + | LinkerInfo = 512u + | TypeOver = 1024u + | LinkerRemove = 2048u + | LinkerComdat = 4096u + | MemProtected = 16384u + | NoDeferSpecExc = 16384u + | GPRel = 32768u + | MemFardata = 32768u + | MemSysheap = 65536u + | MemPurgeable = 131072u + | Mem16Bit = 131072u + | MemLocked = 262144u + | MemPreload = 524288u + | Align1Bytes = 1048576u + | Align2Bytes = 2097152u + | Align4Bytes = 3145728u + | Align8Bytes = 4194304u + | Align16Bytes = 5242880u + | Align32Bytes = 6291456u + | Align64Bytes = 7340032u + | Align128Bytes = 8388608u + | Align256Bytes = 9437184u + | Align512Bytes = 10485760u + | Align1024Bytes = 11534336u + | Align2048Bytes = 12582912u + | Align4096Bytes = 13631488u + | Align8192Bytes = 14680064u + | AlignMask = 15728640u + | LinkerNRelocOvfl = 16777216u + | MemDiscardable = 33554432u + | MemNotCached = 67108864u + | MemNotPaged = 134217728u + | MemShared = 268435456u + | MemExecute = 536870912u + | MemRead = 1073741824u + | MemWrite = 2147483648u + +type ResourceSection() = + new(sectionBytes: byte[], relocations: uint32[]) as this = + (ResourceSection ()) + then + Debug.Assert (sectionBytes :> obj <> Unchecked.defaultof<_>) + Debug.Assert (relocations :> obj <> Unchecked.defaultof<_>) + this.SectionBytes <- sectionBytes + this.Relocations <- relocations + + member val SectionBytes = Unchecked.defaultof with get,set + member val Relocations = Unchecked.defaultof with get,set + +[] +type StreamExtensions () = + [] + static member TryReadAll (stream: Stream, buffer: byte[], offset: int, count: int) = + Debug.Assert (count > 0) + let mutable (totalBytesRead: int) = Unchecked.defaultof + let mutable (isFinished: bool) = false + let mutable (bytesRead: int) = 0 + do + totalBytesRead <- 0 + while totalBytesRead < count && not isFinished do + bytesRead <- stream.Read (buffer, (offset + totalBytesRead), (count - totalBytesRead)) + if bytesRead = 0 then + isFinished <- true // break; + else totalBytesRead <- totalBytesRead + bytesRead + totalBytesRead + +type COFFResourceReader() = + static member private ConfirmSectionValues (hdr: SectionHeader, fileSize: System.Int64) = + if int64 hdr.PointerToRawData + int64 hdr.SizeOfRawData > fileSize then + raise <| ResourceException ("CoffResourceInvalidSectionSize") + + static member ReadWin32ResourcesFromCOFF (stream: Stream) = + let mutable peHeaders = new PEHeaders (stream) + let mutable rsrc1 = SectionHeader () + let mutable rsrc2 = SectionHeader () + let mutable (foundCount: int) = 0 + for sectionHeader in peHeaders.SectionHeaders do + if sectionHeader.Name = ".rsrc$01" then + rsrc1 <- sectionHeader + foundCount <- foundCount + 1 + else + if sectionHeader.Name = ".rsrc$02" then + rsrc2 <- sectionHeader + foundCount <- foundCount + 1 + if foundCount <> 2 then + raise <| ResourceException ("CoffResourceMissingSection") + COFFResourceReader.ConfirmSectionValues (rsrc1, stream.Length) + COFFResourceReader.ConfirmSectionValues (rsrc2, stream.Length) + let mutable imageResourceSectionBytes = Array.zeroCreate (rsrc1.SizeOfRawData + rsrc2.SizeOfRawData) + stream.Seek (int64 rsrc1.PointerToRawData, SeekOrigin.Begin) |> ignore + stream.TryReadAll (imageResourceSectionBytes, 0, rsrc1.SizeOfRawData) |> ignore + stream.Seek (int64 rsrc2.PointerToRawData, SeekOrigin.Begin) |> ignore + stream.TryReadAll (imageResourceSectionBytes, rsrc1.SizeOfRawData, rsrc2.SizeOfRawData) |> ignore + let mutable (SizeOfRelocationEntry: int) = 10 + try + let mutable relocLastAddress = rsrc1.PointerToRelocations + (int rsrc1.NumberOfRelocations * SizeOfRelocationEntry) + if int64 relocLastAddress > stream.Length then + raise <| ResourceException ("CoffResourceInvalidRelocation") + with + :? OverflowException -> (raise <| ResourceException("CoffResourceInvalidRelocation")) + let mutable relocationOffsets = Array.zeroCreate (int rsrc1.NumberOfRelocations) + let mutable relocationSymbolIndices = Array.zeroCreate (int rsrc1.NumberOfRelocations) + let mutable reader = new BinaryReader (stream, Encoding.Unicode) + stream.Position <- int64 rsrc1.PointerToRelocations + do + let mutable (i: int) = 0 + while (i < int rsrc1.NumberOfRelocations) do + relocationOffsets.[i] <- reader.ReadUInt32 () + relocationSymbolIndices.[i] <- reader.ReadUInt32 () + reader.ReadUInt16 () |> ignore //we do nothing with the "Type" + i <- i + 1 + stream.Position <- int64 peHeaders.CoffHeader.PointerToSymbolTable + let mutable (ImageSizeOfSymbol: System.UInt32) = 18u + try + let mutable lastSymAddress = int64 peHeaders.CoffHeader.PointerToSymbolTable + int64 peHeaders.CoffHeader.NumberOfSymbols * int64 ImageSizeOfSymbol (* ERROR UnknownNode *) + if lastSymAddress > stream.Length then + raise <| ResourceException ("CoffResourceInvalidSymbol") + with + :? OverflowException -> (raise <| ResourceException("CoffResourceInvalidSymbol")) + let mutable outputStream = new MemoryStream (imageResourceSectionBytes) + let mutable writer = new BinaryWriter (outputStream) + do + let mutable (i: int) = 0 + while (i < relocationSymbolIndices.Length) do + if int relocationSymbolIndices.[i] > peHeaders.CoffHeader.NumberOfSymbols then + raise <| ResourceException ("CoffResourceInvalidRelocation") + let mutable offsetOfSymbol = int64 peHeaders.CoffHeader.PointerToSymbolTable + int64 relocationSymbolIndices.[i] * int64 ImageSizeOfSymbol + stream.Position <- offsetOfSymbol + stream.Position <- stream.Position + 8L + let mutable symValue = reader.ReadUInt32 () + let mutable symSection = reader.ReadInt16 () + let mutable symType = reader.ReadUInt16 () + let mutable (IMAGE_SYM_TYPE_NULL: System.UInt16) = uint16 0x0000 + if symType <> IMAGE_SYM_TYPE_NULL || symSection <> 3s then + raise <| ResourceException("CoffResourceInvalidSymbol") + outputStream.Position <- int64 relocationOffsets.[i] + writer.Write (uint32 (int64 symValue + int64 rsrc1.SizeOfRawData)) + i <- i + 1 + + ResourceSection(imageResourceSectionBytes, relocationOffsets) + +[] +type ICONDIRENTRY = + val mutable bWidth: BYTE + val mutable bHeight: BYTE + val mutable bColorCount: BYTE + val mutable bReserved: BYTE + val mutable wPlanes: WORD + val mutable wBitCount: WORD + val mutable dwBytesInRes: DWORD + val mutable dwImageOffset: DWORD + +type VersionHelper() = + /// + /// Parses a version string of the form "major [ '.' minor [ '.' build [ '.' revision ] ] ]". + /// + /// The version string to parse. + /// If parsing succeeds, the parsed version. Otherwise a version that represents as much of the input as could be parsed successfully. + /// True when parsing succeeds completely (i.e. every character in the string was consumed), false otherwise. + static member TryParse(s: string, [] version: byref) = + VersionHelper.TryParse (s, false, UInt16.MaxValue, true, ref version) + + /// + /// Parses a version string of the form "major [ '.' minor [ '.' ( '*' | ( build [ '.' ( '*' | revision ) ] ) ) ] ]" + /// as accepted by System.Reflection.AssemblyVersionAttribute. + /// + /// The version string to parse. + /// Indicates whether or not a wildcard is accepted as the terminal component. + /// + /// If parsing succeeded, the parsed version. Otherwise a version instance with all parts set to zero. + /// If contains * the version build and/or revision numbers are set to . + /// + /// True when parsing succeeds completely (i.e. every character in the string was consumed), false otherwise. + + static member TryParseAssemblyVersion (s: string, allowWildcard: System.Boolean, [] version: byref) = + VersionHelper.TryParse (s, allowWildcard, (UInt16.MaxValue - 1us), false, ref version) + + static member private NullVersion = new Version (0, 0, 0, 0) + + /// + /// Parses a version string of the form "major [ '.' minor [ '.' ( '*' | ( build [ '.' ( '*' | revision ) ] ) ) ] ]" + /// as accepted by System.Reflection.AssemblyVersionAttribute. + /// + /// The version string to parse. + /// Indicates whether or not we're parsing an assembly version string. If so, wildcards are accepted and each component must be less than 65535. + /// The maximum value that a version component may have. + /// Allow the parsing of version elements where invalid characters exist. e.g. 1.2.2a.1 + /// + /// If parsing succeeded, the parsed version. When is true a version with values up to the first invalid character set. Otherwise a version with all parts set to zero. + /// If contains * and wildcard is allowed the version build and/or revision numbers are set to . + /// + /// True when parsing succeeds completely (i.e. every character in the string was consumed), false otherwise. + static member private TryParse(s: string, allowWildcard: System.Boolean, maxValue: System.UInt16, allowPartialParse: System.Boolean, [] version: byref) = + Debug.Assert (not allowWildcard || maxValue < UInt16.MaxValue) + if String.IsNullOrWhiteSpace (s) then + version <- VersionHelper.NullVersion + false + else + let mutable (elements: string[]) = s.Split ('.') + let mutable (hasWildcard: System.Boolean) = allowWildcard && elements.[(int (elements.Length - 1))] = "*" + if hasWildcard && elements.Length < 3 || elements.Length > 4 then + version <- VersionHelper.NullVersion + false + else + let mutable (values: uint16[]) = Array.zeroCreate 4 + let mutable (lastExplicitValue: int) = + if hasWildcard then + elements.Length - 1 + else elements.Length + let mutable (parseError: System.Boolean) = false + let mutable earlyReturn = None + do + let mutable (i: int) = 0 + let mutable breakLoop = false + while (i < lastExplicitValue) && not breakLoop do + if not (UInt16.TryParse (elements.[i], System.Globalization.NumberStyles.None, System.Globalization.CultureInfo.InvariantCulture, ref values.[i])) || values.[i] > maxValue then + if not allowPartialParse then + earlyReturn <- Some false + breakLoop <- true + version <- VersionHelper.NullVersion + else + parseError <- true + if String.IsNullOrWhiteSpace (elements.[i]) then + values.[i] <- 0us + breakLoop <- true + else + if values.[i] > maxValue then + values.[i] <- 0us + breakLoop <- true + else + let mutable (invalidFormat: System.Boolean) = false + //let mutable (number: System.Numerics.BigInteger) = 0I + do + let mutable idx = 0 + let mutable breakLoop = false + while (idx < elements.[i].Length) && not breakLoop do + if not (Char.IsDigit (elements.[i].[idx])) then + invalidFormat <- true + VersionHelper.TryGetValue ((elements.[i].Substring (0, idx)), ref values.[i]) |> ignore + breakLoop <- true + else + idx <- idx + 1 + let mutable doBreak = true + if not invalidFormat then + if VersionHelper.TryGetValue (elements.[i], ref values.[i]) then + //For this scenario the old compiler would continue processing the remaining version elements + //so continue processing + doBreak <- false + () (* ERROR ContinueNotSupported *) + (* ERROR BreakNotSupported *) + if not breakLoop then + i <- i + 1 + if hasWildcard then + let mutable (i: int) = lastExplicitValue + while (i < values.Length) do + values.[i] <- UInt16.MaxValue + i <- i + 1 + version <- new Version(int values.[0], int values.[1], int values.[2], int values.[3]) + not parseError + + static member private TryGetValue(s: string, [] value: byref): bool = + let mutable (number: System.Numerics.BigInteger) = Unchecked.defaultof + if System.Numerics.BigInteger.TryParse (s, System.Globalization.NumberStyles.None, System.Globalization.CultureInfo.InvariantCulture, ref number) then + value <- uint16 (number % bigint 65536) + true + else + value <- 0us + false + + static member GenerateVersionFromPatternAndCurrentTime(time: DateTime, pattern: Version) = + if pattern = Unchecked.defaultof<_> || pattern.Revision <> int UInt16.MaxValue then + pattern + else + let mutable time = time + // MSDN doc on the attribute: + // "The default build number increments daily. The default revision number is the number of seconds since midnight local time + // (without taking into account time zone adjustments for daylight saving time), divided by 2." + if time = Unchecked.defaultof then + time <- DateTime.Now + let mutable (revision: int) = int time.TimeOfDay.TotalSeconds / 2 + Debug.Assert (revision < int UInt16.MaxValue) + if pattern.Build = int UInt16.MaxValue then + let mutable (days: TimeSpan) = time.Date - new DateTime(2000, 1, 1) + let mutable (build: int) = Math.Min (int UInt16.MaxValue, (int days.TotalDays)) + new Version(pattern.Major, pattern.Minor, int (uint16 build), int (uint16 revision)) + else + new Version(pattern.Major, pattern.Minor, pattern.Build, int (uint16 revision)) + +type VersionResourceSerializer () = + member val private _commentsContents = Unchecked.defaultof with get, set + member val private _companyNameContents = Unchecked.defaultof with get, set + member val private _fileDescriptionContents = Unchecked.defaultof with get, set + member val private _fileVersionContents = Unchecked.defaultof with get, set + member val private _internalNameContents = Unchecked.defaultof with get, set + member val private _legalCopyrightContents = Unchecked.defaultof with get, set + member val private _legalTrademarksContents = Unchecked.defaultof with get, set + member val private _originalFileNameContents = Unchecked.defaultof with get, set + member val private _productNameContents = Unchecked.defaultof with get, set + member val private _productVersionContents = Unchecked.defaultof with get, set + member val private _assemblyVersionContents = Unchecked.defaultof with get, set + static member val private vsVersionInfoKey = "VS_VERSION_INFO" with get, set + static member val private varFileInfoKey = "VarFileInfo" with get, set + static member val private translationKey = "Translation" with get, set + static member val private stringFileInfoKey = "StringFileInfo" with get, set + member val private _langIdAndCodePageKey = Unchecked.defaultof with get, set + + static member val private CP_WINUNICODE = 1200u + static member val private sizeVS_FIXEDFILEINFO = uint16 (sizeof * 13) + + member val private _isDll = Unchecked.defaultof with get, set + + new(isDll: System.Boolean, comments: string, companyName: string, fileDescription: string, fileVersion: string, internalName: string, legalCopyright: string, legalTrademark: string, originalFileName: string, productName: string, productVersion: string, assemblyVersion: Version) as this = + (VersionResourceSerializer ()) + then + this._isDll <- isDll + this._commentsContents <- comments + this._companyNameContents <- companyName + this._fileDescriptionContents <- fileDescription + this._fileVersionContents <- fileVersion + this._internalNameContents <- internalName + this._legalCopyrightContents <- legalCopyright + this._legalTrademarksContents <- legalTrademark + this._originalFileNameContents <- originalFileName + this._productNameContents <- productName + this._productVersionContents <- productVersion + this._assemblyVersionContents <- assemblyVersion + this._langIdAndCodePageKey <- System.String.Format ("{0:x4}{1:x4}", 0, VersionResourceSerializer.CP_WINUNICODE) + + static member val private VFT_APP = 0x00000001u + static member val private VFT_DLL = 0x00000002u + + member private this.GetVerStrings() = seq { + if this._commentsContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("Comments", this._commentsContents) + if this._companyNameContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("CompanyName", this._companyNameContents) + if this._fileDescriptionContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("FileDescription", this._fileDescriptionContents) + yield KeyValuePair<_,_>("FileVersion", this._fileVersionContents) + if this._internalNameContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("InternalName", this._internalNameContents) + if this._legalCopyrightContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("LegalCopyright", this._legalCopyrightContents) + if this._legalTrademarksContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("LegalTrademarks", this._legalTrademarksContents) + if this._originalFileNameContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("OriginalFilename", this._originalFileNameContents) + if this._productNameContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("ProductName", this._productNameContents) + yield KeyValuePair<_,_>("ProductVersion", this._fileVersionContents) + if this._assemblyVersionContents <> Unchecked.defaultof<_> then + yield KeyValuePair<_,_>("Assembly Version", this._assemblyVersionContents.ToString()) + } + + member private this.FileType : uint32 = + if this._isDll then + VersionResourceSerializer.VFT_DLL + else + VersionResourceSerializer.VFT_APP + + member private this.WriteVSFixedFileInfo(writer: BinaryWriter) = + let mutable (fileVersion: Version) = Unchecked.defaultof + VersionHelper.TryParse (this._fileVersionContents, ref fileVersion) |> ignore + let mutable (productVersion: Version) = Unchecked.defaultof + VersionHelper.TryParse (this._productVersionContents, ref productVersion) |> ignore + writer.Write (0xFEEF04BDu) + writer.Write (0x00010000u) + writer.Write ((uint32 fileVersion.Major <<< 16) ||| uint32 fileVersion.Minor) + writer.Write ((uint32 fileVersion.Build <<< 16) ||| uint32 fileVersion.Revision) + writer.Write ((uint32 productVersion.Major <<< 16) ||| uint32 productVersion.Minor) + writer.Write ((uint32 productVersion.Build <<< 16) ||| uint32 productVersion.Revision) + writer.Write (0x0000003Fu) + writer.Write (0u) + writer.Write (0x00000004u) + writer.Write (this.FileType) + writer.Write (0u) + writer.Write (0u) + writer.Write (0u) + + static member private PadKeyLen(cb: int) = + VersionResourceSerializer.PadToDword (cb + 3 * sizeof) - 3 * sizeof + + static member private PadToDword(cb: int) = + cb + 3 &&& ~~~3 + + static member val private HDRSIZE = (int (3 * sizeof)) with get, set + + static member private SizeofVerString(lpszKey: string, lpszValue: string) = + let mutable (cbKey: int) = Unchecked.defaultof + let mutable (cbValue: int) = Unchecked.defaultof + cbKey <- lpszKey.Length + 1 * 2 + cbValue <- lpszValue.Length + 1 * 2 + VersionResourceSerializer.PadKeyLen(cbKey) + cbValue + VersionResourceSerializer.HDRSIZE + + static member private WriteVersionString(keyValuePair: KeyValuePair, writer: BinaryWriter) = + Debug.Assert (keyValuePair.Value <> Unchecked.defaultof<_>) + let mutable (cbBlock: System.UInt16) = uint16 <| VersionResourceSerializer.SizeofVerString (keyValuePair.Key, keyValuePair.Value) + let mutable (cbKey: int) = keyValuePair.Key.Length + 1 * 2 + //let mutable (cbVal: int) = keyValuePair.Value.Length + 1 * 2 + let mutable startPos = writer.BaseStream.Position + Debug.Assert (startPos &&& 3L = 0L) + writer.Write (cbBlock) + writer.Write (uint16 (keyValuePair.Value.Length + 1)) + writer.Write (1us) + writer.Write (keyValuePair.Key.ToCharArray ()) + writer.Write (uint16 0) //(WORD)'\0' + writer.Write (Array.zeroCreate (VersionResourceSerializer.PadKeyLen (cbKey) - cbKey): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + writer.Write (keyValuePair.Value.ToCharArray ()) + writer.Write (uint16 0) // (WORD)'\0' + Debug.Assert (int64 cbBlock = writer.BaseStream.Position - startPos) + + static member private KEYSIZE(sz: string) = + VersionResourceSerializer.PadKeyLen (sz.Length + 1 * sizeof) / sizeof + + static member private KEYBYTES(sz: string) = + VersionResourceSerializer.KEYSIZE (sz) * sizeof + + member private this.GetStringsSize() = + let mutable (sum: int) = 0 + for verString in this.GetVerStrings () do + sum <- sum + 3 &&& ~~~3 + sum <- sum + VersionResourceSerializer.SizeofVerString (verString.Key, verString.Value) + sum + + member this.GetDataSize () = + let mutable (sizeEXEVERRESOURCE: int) = + sizeof * 3 * 5 + 2 * sizeof + + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.vsVersionInfoKey) + + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.varFileInfoKey) + + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.translationKey) + + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.stringFileInfoKey) + + VersionResourceSerializer.KEYBYTES (this._langIdAndCodePageKey) + + int VersionResourceSerializer.sizeVS_FIXEDFILEINFO + this.GetStringsSize () + sizeEXEVERRESOURCE + + member this.WriteVerResource (writer: BinaryWriter) = + let mutable debugPos = writer.BaseStream.Position + let mutable dataSize = this.GetDataSize () + writer.Write (WORD dataSize) + writer.Write (WORD VersionResourceSerializer.sizeVS_FIXEDFILEINFO) + writer.Write (WORD 0us) + writer.Write (VersionResourceSerializer.vsVersionInfoKey.ToCharArray ()) + writer.Write (Array.zeroCreate (VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.vsVersionInfoKey) - VersionResourceSerializer.vsVersionInfoKey.Length * 2): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + this.WriteVSFixedFileInfo (writer) + writer.Write (WORD (sizeof * 2 + 2 * VersionResourceSerializer.HDRSIZE + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.varFileInfoKey) + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.translationKey))) + writer.Write (WORD 0us) + writer.Write (WORD 1us) + writer.Write (VersionResourceSerializer.varFileInfoKey.ToCharArray ()) + writer.Write (Array.zeroCreate (VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.varFileInfoKey) - VersionResourceSerializer.varFileInfoKey.Length * 2): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + writer.Write (WORD (sizeof * 2 + VersionResourceSerializer.HDRSIZE + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.translationKey))) + writer.Write (WORD (sizeof * 2)) + writer.Write (WORD 0us) + writer.Write (VersionResourceSerializer.translationKey.ToCharArray ()) + writer.Write (Array.zeroCreate (VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.translationKey) - VersionResourceSerializer.translationKey.Length * 2): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + writer.Write (0us) + writer.Write (WORD VersionResourceSerializer.CP_WINUNICODE) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + writer.Write (WORD (2 * VersionResourceSerializer.HDRSIZE + VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.stringFileInfoKey) + VersionResourceSerializer.KEYBYTES (this._langIdAndCodePageKey) + this.GetStringsSize ())) + writer.Write (0us) + writer.Write (1us) + writer.Write (VersionResourceSerializer.stringFileInfoKey.ToCharArray ()) + writer.Write (Array.zeroCreate (VersionResourceSerializer.KEYBYTES (VersionResourceSerializer.stringFileInfoKey) - VersionResourceSerializer.stringFileInfoKey.Length * 2): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + writer.Write (WORD (VersionResourceSerializer.HDRSIZE + VersionResourceSerializer.KEYBYTES (this._langIdAndCodePageKey) + this.GetStringsSize ())) + writer.Write (0us) + writer.Write (1us) + writer.Write (this._langIdAndCodePageKey.ToCharArray ()) + writer.Write (Array.zeroCreate (VersionResourceSerializer.KEYBYTES (this._langIdAndCodePageKey) - this._langIdAndCodePageKey.Length * 2): byte[]) + Debug.Assert (writer.BaseStream.Position &&& 3L = 0L) + Debug.Assert (writer.BaseStream.Position - debugPos = int64 dataSize - int64 (this.GetStringsSize ())) + debugPos <- writer.BaseStream.Position + for entry in this.GetVerStrings () do + let mutable writerPos = writer.BaseStream.Position + writer.Write (Array.zeroCreate (int ((writerPos + 3L) &&& ~~~3L - writerPos)): byte[]) + Debug.Assert (entry.Value <> Unchecked.defaultof<_>) + VersionResourceSerializer.WriteVersionString (entry, writer) + Debug.Assert (writer.BaseStream.Position - debugPos = int64 (this.GetStringsSize ())) + +type Win32ResourceConversions () = + static member AppendIconToResourceStream(resStream: Stream, iconStream: Stream) = + let mutable iconReader = new BinaryReader(iconStream) + let mutable reserved = iconReader.ReadUInt16 () + if reserved <> 0us then + raise <| ResourceException("IconStreamUnexpectedFormat") + let mutable ``type`` = iconReader.ReadUInt16 () + if ``type`` <> 1us then + raise <| ResourceException("IconStreamUnexpectedFormat") + let mutable count = iconReader.ReadUInt16 () + if count = 0us then + raise <| ResourceException("IconStreamUnexpectedFormat") + let mutable iconDirEntries: ICONDIRENTRY [] = Array.zeroCreate (int count) + do + let mutable (i: System.UInt16) = 0us + while (i < count) do + iconDirEntries.[(int i)].bWidth <- iconReader.ReadByte () + iconDirEntries.[(int i)].bHeight <- iconReader.ReadByte () + iconDirEntries.[(int i)].bColorCount <- iconReader.ReadByte () + iconDirEntries.[(int i)].bReserved <- iconReader.ReadByte () + iconDirEntries.[(int i)].wPlanes <- iconReader.ReadUInt16 () + iconDirEntries.[(int i)].wBitCount <- iconReader.ReadUInt16 () + iconDirEntries.[(int i)].dwBytesInRes <- iconReader.ReadUInt32 () + iconDirEntries.[(int i)].dwImageOffset <- iconReader.ReadUInt32 () + i <- i + 1us + do + let mutable (i: System.UInt16) = 0us + while (i < count) do + iconStream.Position <- int64 iconDirEntries.[(int i)].dwImageOffset + if iconReader.ReadUInt32 () = 40u then + iconStream.Position <- iconStream.Position + 8L + iconDirEntries.[(int i)].wPlanes <- iconReader.ReadUInt16 () + iconDirEntries.[(int i)].wBitCount <- iconReader.ReadUInt16 () + i <- i + 1us + + let mutable resWriter = new BinaryWriter(resStream) + let mutable (RT_ICON: WORD) = 3us + do + let mutable (i: System.UInt16) = 0us + while (i < count) do + resStream.Position <- resStream.Position + 3L &&& ~~~3L + resWriter.Write (iconDirEntries.[(int i)].dwBytesInRes) + resWriter.Write (0x00000020u) + resWriter.Write (0xFFFFus) + resWriter.Write (RT_ICON) + resWriter.Write (0xFFFFus) + resWriter.Write ((i + 1us)) + resWriter.Write (0x00000000u) + resWriter.Write (0x1010us) + resWriter.Write (0x0000us) + resWriter.Write (0x00000000u) + resWriter.Write (0x00000000u) + iconStream.Position <- int64 iconDirEntries.[(int i)].dwImageOffset + resWriter.Write (iconReader.ReadBytes (int (iconDirEntries.[int i].dwBytesInRes))) + i <- i + 1us + + let mutable (RT_GROUP_ICON: WORD) = (RT_ICON + 11us) + resStream.Position <- resStream.Position + 3L &&& ~~~3L + resWriter.Write (uint32 (3 * sizeof + int count * 14)) + resWriter.Write (0x00000020u) + resWriter.Write (0xFFFFus) + resWriter.Write (RT_GROUP_ICON) + resWriter.Write (0xFFFFus) + resWriter.Write (0x7F00us) + resWriter.Write (0x00000000u) + resWriter.Write (0x1030us) + resWriter.Write (0x0000us) + resWriter.Write (0x00000000u) + resWriter.Write (0x00000000u) + resWriter.Write (0x0000us) + resWriter.Write (0x0001us) + resWriter.Write (count) + do + let mutable (i: System.UInt16) = 0us + while (i < count) do + resWriter.Write (iconDirEntries.[(int i)].bWidth) + resWriter.Write (iconDirEntries.[(int i)].bHeight) + resWriter.Write (iconDirEntries.[(int i)].bColorCount) + resWriter.Write (iconDirEntries.[(int i)].bReserved) + resWriter.Write (iconDirEntries.[(int i)].wPlanes) + resWriter.Write (iconDirEntries.[(int i)].wBitCount) + resWriter.Write (iconDirEntries.[(int i)].dwBytesInRes) + resWriter.Write ((i + 1us)) + i <- i + 1us + () + + static member AppendVersionToResourceStream (resStream: Stream, isDll: System.Boolean, fileVersion: string, originalFileName: string, internalName: string, productVersion: string, assemblyVersion: Version, ?fileDescription: string, ?legalCopyright: string, ?legalTrademarks: string, ?productName: string, ?comments: string, ?companyName: string) = + let fileDescription = (defaultArg fileDescription) " " + let legalCopyright = (defaultArg legalCopyright) " " + let legalTrademarks = (defaultArg legalTrademarks) Unchecked.defaultof<_> + let productName = (defaultArg productName) Unchecked.defaultof<_> + let comments = (defaultArg comments) Unchecked.defaultof<_> + let companyName = (defaultArg companyName) Unchecked.defaultof<_> + let mutable resWriter = new BinaryWriter(resStream, Encoding.Unicode) + resStream.Position <- resStream.Position + 3L &&& ~~~3L + let mutable (RT_VERSION: DWORD) = 16u + let mutable ver = new VersionResourceSerializer(isDll, comments, companyName, fileDescription, fileVersion, internalName, legalCopyright, legalTrademarks, originalFileName, productName, productVersion, assemblyVersion) + let mutable startPos = resStream.Position + let mutable dataSize = ver.GetDataSize () + let mutable (headerSize: int) = 0x20 + resWriter.Write (uint32 dataSize) + resWriter.Write (uint32 headerSize) + resWriter.Write (0xFFFFus) + resWriter.Write (uint16 RT_VERSION) + resWriter.Write (0xFFFFus) + resWriter.Write (0x0001us) + resWriter.Write (0x00000000u) + resWriter.Write (0x0030us) + resWriter.Write (0x0000us) + resWriter.Write (0x00000000u) + resWriter.Write (0x00000000u) + ver.WriteVerResource (resWriter) + Debug.Assert (resStream.Position - startPos = int64 dataSize + int64 headerSize) + + static member AppendManifestToResourceStream(resStream: Stream, manifestStream: Stream, isDll: System.Boolean) = + resStream.Position <- resStream.Position + 3L &&& ~~~3L (* ERROR UnknownPrefixOperator "~" *) + let mutable (RT_MANIFEST: WORD) = 24us + let mutable resWriter = new BinaryWriter(resStream) + resWriter.Write (uint32 manifestStream.Length) + resWriter.Write (0x00000020u) + resWriter.Write (0xFFFFus) + resWriter.Write (RT_MANIFEST) + resWriter.Write (0xFFFFus) + resWriter.Write (if isDll then 0x0002us else 0x0001us) + resWriter.Write (0x00000000u) + resWriter.Write (0x1030us) + resWriter.Write (0x0000us) + resWriter.Write (0x00000000u) + resWriter.Write (0x00000000u) + manifestStream.CopyTo (resStream) + + +type Win32Resource (data: byte[], codePage: DWORD, languageId: DWORD, id: int, name: string, typeId: int, typeName: string) = + member val Data = data + member val CodePage = codePage + member val LanguageId = languageId + member val Id = id + member val Name = name + member val TypeId = typeId + member val TypeName = typeName + +type Directory (name, id) = + member val Name = name + member val ID = id + member val NumberOfNamedEntries = Unchecked.defaultof with get, set + member val NumberOfIdEntries = Unchecked.defaultof with get, set + member val Entries = new List() + +type NativeResourceWriter () = + static member private CompareResources (left: Win32Resource) (right: Win32Resource) = + let mutable (result: int) = NativeResourceWriter.CompareResourceIdentifiers (left.TypeId, left.TypeName, right.TypeId, right.TypeName) + if result = 0 then + NativeResourceWriter.CompareResourceIdentifiers (left.Id, left.Name, right.Id, right.Name) + else result + + static member private CompareResourceIdentifiers (xOrdinal: int, xString: string, yOrdinal: int, yString: string) = + if xString = Unchecked.defaultof<_> then + if yString = Unchecked.defaultof<_> then + xOrdinal - yOrdinal + else + 1 + else + if yString = Unchecked.defaultof<_> then + -1 + else + String.Compare (xString, yString, StringComparison.OrdinalIgnoreCase) + + static member SortResources (resources: IEnumerable) = + resources.OrderBy ((fun d -> d), Comparer<_>.Create(Comparison<_> NativeResourceWriter.CompareResources)) :> IEnumerable + + static member SerializeWin32Resources (builder: BlobBuilder, theResources: IEnumerable, resourcesRva: int) = + let theResources = NativeResourceWriter.SortResources (theResources) + let mutable (typeDirectory: Directory) = new Directory(String.Empty, 0) + let mutable (nameDirectory: Directory) = Unchecked.defaultof<_> + let mutable (languageDirectory: Directory) = Unchecked.defaultof<_> + let mutable (lastTypeID: int) = Int32.MinValue + let mutable (lastTypeName: string) = Unchecked.defaultof<_> + let mutable (lastID: int) = Int32.MinValue + let mutable (lastName: string) = Unchecked.defaultof<_> + let mutable (sizeOfDirectoryTree: System.UInt32) = 16u + for (r: Win32Resource) in theResources do + let mutable (typeDifferent: System.Boolean) = r.TypeId < 0 && r.TypeName <> lastTypeName || r.TypeId > lastTypeID + if typeDifferent then + lastTypeID <- r.TypeId + lastTypeName <- r.TypeName + if lastTypeID < 0 then + Debug.Assert ((typeDirectory.NumberOfIdEntries = 0us), "Not all Win32 resources with types encoded as strings precede those encoded as ints") + typeDirectory.NumberOfNamedEntries <- typeDirectory.NumberOfNamedEntries + 1us + else + typeDirectory.NumberOfIdEntries <- typeDirectory.NumberOfIdEntries + 1us + sizeOfDirectoryTree <- sizeOfDirectoryTree + 24u + nameDirectory <- new Directory(lastTypeName, lastTypeID) + typeDirectory.Entries.Add (nameDirectory) + if typeDifferent || r.Id < 0 && r.Name <> lastName || r.Id > lastID then + lastID <- r.Id + lastName <- r.Name + if lastID < 0 then + Debug.Assert ((nameDirectory.NumberOfIdEntries = 0us), "Not all Win32 resources with names encoded as strings precede those encoded as ints") + nameDirectory.NumberOfNamedEntries <- nameDirectory.NumberOfNamedEntries + 1us + else + nameDirectory.NumberOfIdEntries <- nameDirectory.NumberOfIdEntries + 1us + sizeOfDirectoryTree <- sizeOfDirectoryTree + 24u + languageDirectory <- new Directory (lastName, lastID) + nameDirectory.Entries.Add (languageDirectory) + languageDirectory.NumberOfIdEntries <- languageDirectory.NumberOfIdEntries + 1us + sizeOfDirectoryTree <- sizeOfDirectoryTree + 8u + languageDirectory.Entries.Add (r) + let mutable dataWriter = new BlobBuilder() + NativeResourceWriter.WriteDirectory (typeDirectory, builder, (0u), (0u), sizeOfDirectoryTree, resourcesRva, dataWriter) + builder.LinkSuffix (dataWriter) + builder.WriteByte (0uy) + builder.Align (4) + + static member private WriteDirectory (directory: Directory, writer: BlobBuilder, offset: System.UInt32, level: System.UInt32, sizeOfDirectoryTree: System.UInt32, virtualAddressBase: int, dataWriter: BlobBuilder) = + writer.WriteUInt32 (0u) + writer.WriteUInt32 (0u) + writer.WriteUInt32 (0u) + writer.WriteUInt16 (directory.NumberOfNamedEntries) + writer.WriteUInt16 (directory.NumberOfIdEntries) + let mutable (n: System.UInt32) = uint32 directory.Entries.Count + let mutable (k: System.UInt32) = offset + 16u + n * 8u + do + let mutable (i: uint32) = 0u + while (i < n) do + let mutable (id: int) = Unchecked.defaultof + let mutable (name: string) = Unchecked.defaultof + let mutable (nameOffset: System.UInt32) = uint32 dataWriter.Count + sizeOfDirectoryTree + let mutable (directoryOffset: System.UInt32) = k + let isDir = + match directory.Entries.[int i] with + | :? Directory as subDir -> + id <- subDir.ID + name <- subDir.Name + if level = 0u then k <- k + NativeResourceWriter.SizeOfDirectory (subDir) + else k <- k + 16u + 8u * uint32 subDir.Entries.Count + true + | :? Win32Resource as r -> + id <- + if level = 0u then + r.TypeId + else + if level = 1u then + r.Id + else + int r.LanguageId + name <- + if level = 0u then + r.TypeName + else + if level = 1u then + r.Name + else + Unchecked.defaultof<_> + dataWriter.WriteUInt32 ((uint32 virtualAddressBase + sizeOfDirectoryTree + 16u + uint32 dataWriter.Count)) + let mutable (data: byte[]) = (new List (r.Data)).ToArray () + dataWriter.WriteUInt32 (uint32 data.Length) + dataWriter.WriteUInt32 (r.CodePage) + dataWriter.WriteUInt32 (0u) + dataWriter.WriteBytes (data) + while (dataWriter.Count % 4 <> 0) do + dataWriter.WriteByte (0uy) + false + | e -> failwithf "Unknown entry %s" (if isNull e then "" else e.GetType().FullName) + if id >= 0 then writer.WriteInt32 (id) + else + if name = Unchecked.defaultof<_> then + name <- String.Empty + writer.WriteUInt32 (nameOffset ||| 0x80000000u) + dataWriter.WriteUInt16 (uint16 name.Length) + dataWriter.WriteUTF16 (name) + if isDir then writer.WriteUInt32 (directoryOffset ||| 0x80000000u) + else writer.WriteUInt32 (nameOffset) + i <- i + 1u + + k <- offset + 16u + n * 8u + do + let mutable (i: int) = 0 + while (uint32 i < n) do + match directory.Entries.[i] with + | :? Directory as subDir -> + NativeResourceWriter.WriteDirectory (subDir, writer, k, (level + 1u), sizeOfDirectoryTree, virtualAddressBase, dataWriter) + if level = 0u then + k <- k + NativeResourceWriter.SizeOfDirectory (subDir) + else + k <- k + 16u + 8u * uint32 subDir.Entries.Count + | _ -> () + i <- i + 1 + () + + static member private SizeOfDirectory (directory: Directory) = + let mutable (n: System.UInt32) = uint32 directory.Entries.Count + let mutable (size: System.UInt32) = 16u + 8u * n + do + let mutable (i: int) = 0 + while (uint32 i < n) do + match directory.Entries.[i] with + | :? Directory as subDir -> + size <- size + 16u + 8u * uint32 subDir.Entries.Count + | _ -> () + i <- i + 1 + size + + (* + static member SerializeWin32Resources (builder: BlobBuilder, resourceSections: ResourceSection, resourcesRva: int) = + let mutable sectionWriter = new BlobWriter (builder.ReserveBytes (resourceSections.SectionBytes.Length)) + sectionWriter.WriteBytes (resourceSections.SectionBytes) + let mutable readStream = new MemoryStream (resourceSections.SectionBytes) + let mutable reader = new BinaryReader (readStream) + for (addressToFixup: int) in resourceSections.Relocations do + sectionWriter.Offset <- addressToFixup + reader.BaseStream.Position <- addressToFixup + sectionWriter.WriteUInt32 (reader.ReadUInt32 () + resourcesRva :> System.UInt32) + ()*) \ No newline at end of file diff --git a/src/absil/ilnativeres.fsi b/src/absil/ilnativeres.fsi new file mode 100644 index 0000000000..c958240085 --- /dev/null +++ b/src/absil/ilnativeres.fsi @@ -0,0 +1,62 @@ + +module internal FSharp.Compiler.AbstractIL.Internal.NativeRes + +open System +open System.Collections.Generic +open System.Linq +open System.Diagnostics +open System.IO +open System.Reflection.Metadata + +type BYTE = System.Byte +type DWORD = System.UInt32 +type WCHAR = System.Char +type WORD = System.UInt16 + +[] +type RESOURCE_STRING = + member Ordinal: WORD with get, set + member theString : string with get, set + +[] +type RESOURCE = + member pstringType : RESOURCE_STRING with get, set + member pstringName : RESOURCE_STRING with get, set + member DataSize : DWORD with get, set + member HeaderSize : DWORD with get, set + member DataVersion : DWORD with get, set + member MemoryFlags : WORD with get, set + member LanguageId : WORD with get, set + member Version : DWORD with get, set + member Characteristics : DWORD with get, set + member data : byte[] with get, set + +type Win32Resource = + new : data:byte [] * codePage: DWORD * languageId: DWORD * id: int * + name: string * typeId:int * typeName : string -> Win32Resource + member CodePage: DWORD + member Data: byte [] + member Id: int + member LanguageId : DWORD + member Name: string + member TypeId: int + member TypeName: string + +[] +type CvtResFile = + static member ReadResFile : stream:Stream -> System.Collections.Generic.List + +[] +type Win32ResourceConversions = + static member AppendIconToResourceStream : resStream:Stream * iconStream:Stream -> unit + static member AppendVersionToResourceStream : resStream:Stream * isDll:System.Boolean * fileVersion:string * originalFileName:string * internalName:string * productVersion:string * assemblyVersion:Version * ?fileDescription:string * ?legalCopyright:string * ?legalTrademarks:string * ?productName:string * ?comments:string * ?companyName:string -> unit + static member AppendManifestToResourceStream : resStream:Stream * manifestStream:Stream * isDll:System.Boolean -> unit + +// Write native resources +[] +type NativeResourceWriter = + static member SortResources: resources: IEnumerable -> IEnumerable + static member SerializeWin32Resources: builder:BlobBuilder * theResources: IEnumerable * resourcesRva: int -> unit + (* + static member SerializeWin32Resources (builder : BlobBuilder, resourceSections : ResourceSection, resourcesRva : int) -> unit + ()*) \ No newline at end of file diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 280bbf0c38..38c1c5ff81 100755 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -20,9 +20,7 @@ open Internal.Utilities open Internal.Utilities.Collections open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal -#if !FX_NO_PDB_READER -open FSharp.Compiler.AbstractIL.Internal.Support -#endif +open FSharp.Compiler.AbstractIL.Internal.Support open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.Internal.BinaryConstants open FSharp.Compiler.AbstractIL.IL @@ -1551,14 +1549,10 @@ let readNativeResources (pectxt: PEReader) = [ if pectxt.nativeResourcesSize <> 0x0 && pectxt.nativeResourcesAddr <> 0x0 then let start = pectxt.anyV2P (pectxt.fileName + ": native resources", pectxt.nativeResourcesAddr) if pectxt.noFileOnDisk then -#if !FX_NO_LINKEDRESOURCES let unlinkedResource = let linkedResource = seekReadBytes (pectxt.pefile.GetView()) start pectxt.nativeResourcesSize unlinkResource pectxt.nativeResourcesAddr linkedResource yield ILNativeResource.Out unlinkedResource -#else - () -#endif else yield ILNativeResource.In (pectxt.fileName, pectxt.nativeResourcesAddr, start, pectxt.nativeResourcesSize ) ] diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index fa49d64c9e..4bb5c9832d 100755 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -24,10 +24,6 @@ open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Range open FSharp.Core.Printf -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - let codeLabelOrder = ComparisonIdentity.Structural // Convert the output of convCustomAttr @@ -314,10 +310,8 @@ let convAssemblyRef (aref: ILAssemblyRef) = asmName.Version <- System.Version (int32 version.Major, int32 version.Minor, int32 version.Build, int32 version.Revision) Option.iter setVersion aref.Version // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL -#if !FX_RESHAPED_GLOBALIZATION //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture name) aref.Locale asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture -#endif asmName /// The global environment. @@ -665,9 +659,6 @@ let TypeBuilderInstantiationT = ty let typeIsNotQueryable (ty: Type) = -#if FX_RESHAPED_REFLECTION - let ty = ty.GetTypeInfo() -#endif (ty :? TypeBuilder) || ((ty.GetType()).Equals(TypeBuilderInstantiationT)) //---------------------------------------------------------------------------- // convFieldSpec @@ -796,11 +787,7 @@ let queryableTypeGetMethod cenv emEnv parentT (mref: ILMethodRef) = parentT.GetMethod(mref.Name, cconv ||| BindingFlags.Public ||| BindingFlags.NonPublic, null, argTs, -#if FX_RESHAPED_REFLECTION - (null: obj[])) -#else (null: ParameterModifier[])) -#endif // This can fail if there is an ambiguity w.r.t. return type with _ -> null if (isNonNull methInfo && equalTypes resT methInfo.ReturnType) then @@ -1436,11 +1423,7 @@ let buildGenParamsPass1 _emEnv defineGenericParameters (gps: ILGenericParameterD let buildGenParamsPass1b cenv emEnv (genArgs: Type array) (gps: ILGenericParameterDefs) = -#if FX_RESHAPED_REFLECTION - let genpBs = genArgs |> Array.map (fun x -> (x.GetTypeInfo() :?> GenericTypeParameterBuilder)) -#else let genpBs = genArgs |> Array.map (fun x -> (x :?> GenericTypeParameterBuilder)) -#endif gps |> List.iteri (fun i (gp: ILGenericParameterDef) -> let gpB = genpBs.[i] // the Constraints are either the parent (base) type or interfaces. diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index ba72c0292f..a3eca5b110 100755 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -8,9 +8,11 @@ open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Bytes open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.NativeRes #if FX_NO_CORHOST_SIGNER open FSharp.Compiler.AbstractIL.Internal.StrongNameSign #endif + open System open System.IO open System.Text @@ -22,24 +24,21 @@ open System.Diagnostics.SymbolStore open System.Runtime.InteropServices open System.Runtime.CompilerServices + let DateTime1970Jan01 = new DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) (* ECMA Spec (Oct2002), Part II, 24.2.2 PE File Header. *) let absilWriteGetTimeStamp () = (DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int -#if !FX_NO_LINKEDRESOURCES // Force inline, so GetLastWin32Error calls are immediately after interop calls as seen by FxCop under Debug build. let inline ignore _x = () // Native Resource linking/unlinking type IStream = System.Runtime.InteropServices.ComTypes.IStream -#endif let check _action (hresult) = if uint32 hresult >= 0x80000000ul then System.Runtime.InteropServices.Marshal.ThrowExceptionForHR hresult //printf "action = %s, hresult = 0x%nx \n" action hresult -type PEFileType = X86 | X64 - let MAX_PATH = 260 let E_FAIL = 0x80004005 @@ -56,7 +55,6 @@ let bytesToQWord ((b0: byte), (b1: byte), (b2: byte), (b3: byte), (b4: byte), (b let dwToBytes n = [| byte (n &&& 0xff) ; byte ((n >>> 8) &&& 0xff) ; byte ((n >>> 16) &&& 0xff) ; byte ((n >>> 24) &&& 0xff) |], 4 let wToBytes (n: int16) = [| byte (n &&& 0xffs) ; byte ((n >>> 8) &&& 0xffs) |], 2 -#if !FX_NO_LINKEDRESOURCES // REVIEW: factor these classes under one hierarchy, use reflection for creation from buffer and toBytes() // Though, everything I'd like to unify is static - metaclasses? type IMAGE_FILE_HEADER (m: int16, secs: int16, tds: int32, ptst: int32, nos: int32, soh: int16, c: int16) = @@ -572,173 +570,23 @@ type ResFormatNode(tid: int32, nid: int32, lid: int32, dataOffset: int32, pbLink !size -let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) (fileType: PEFileType) (outputFilePath: string) = - let nPEFileType = match fileType with X86 -> 0 | X64 -> 2 - let mutable tempResFiles: string list = [] - let mutable objBytes: byte[] = [||] - - let unlinkedResources = unlinkedResources |> List.filter (fun arr -> arr.Length > 0) - if isNil unlinkedResources then // bail if there's nothing to link - objBytes - else - // Part 1: Write unlinked resources to an object file for linking - // check if the first dword is 0x0 - let firstDWord = bytesToDWord(unlinkedResources.[0].[0], unlinkedResources.[0].[1], unlinkedResources.[0].[2], unlinkedResources.[0].[3]) - if firstDWord = 0 then - // build the command line invocation string for cvtres.exe - let corSystemDir = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() - // We'll use the current dir and a random file name rather than System.IO.Path.GetTempFileName - // to try and prevent the command line invocation string from being > MAX_PATH - - let outputFilePaths = - if outputFilePath = "" then - [ FileSystem.GetTempPathShim() ] - else - [ FileSystem.GetTempPathShim() ; (outputFilePath + "\\") ] - - // Get a unique random file - let rec GetUniqueRandomFileName path = - let tfn = path + System.IO.Path.GetRandomFileName() - if FileSystem.SafeExists tfn then - GetUniqueRandomFileName path - else - tfn - - - let machine = if 2 = nPEFileType then "X64" else "X86" - let cmdLineArgsPreamble = sprintf "/NOLOGO /READONLY /MACHINE:%s" machine - - let cvtres = corSystemDir + "cvtres.exe " - - let createCvtresArgs path = - let tempObjFileName = GetUniqueRandomFileName path - let mutable cmdLineArgs = sprintf "%s \"/Out:%s\"" cmdLineArgsPreamble tempObjFileName - let mutable resFiles: string list = [] - - for _ulr in unlinkedResources do - let tempResFileName = GetUniqueRandomFileName path - resFiles <- tempResFileName :: resFiles - cmdLineArgs <- cmdLineArgs + " \"" + tempResFileName + "\"" - let trf = resFiles - let cmd = cmdLineArgs - cmd, tempObjFileName, trf - - let cmdLineArgs, tempObjFileName, tempResFileNames = - let attempts = - outputFilePaths |> - List.map (fun path -> createCvtresArgs path) |> - List.filter (fun ((argstring: string), (_t: string), (_f: string list)) -> (cvtres.Length + argstring.Length) < MAX_PATH) - let invoc, tmp, files = - match attempts with - | [] -> createCvtresArgs ".\\" // hope for the best... - | (i, t, f) :: _rest -> i, t, f // use the first one, since they're listed in order of precedence - tempResFiles <- files - (invoc, tmp, files) - - let cvtresInvocation = cvtres + cmdLineArgs - - try - let mutable iFiles = 0 - - for ulr in unlinkedResources do - // REVIEW: What can go wrong here? What happens when the various file calls fail - // dump the unlinked resource bytes into the temp file - System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) - iFiles <- iFiles + 1 - - // call cvtres.exe using the full cmd line string we've generated - - // check to see if the generated string is too long - if it is, fail with E_FAIL - if cvtresInvocation.Length >= MAX_PATH then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - // REVIEW: We really shouldn't be calling out to cvtres - let mutable psi = System.Diagnostics.ProcessStartInfo cvtres - psi.Arguments <- cmdLineArgs - psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden - psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden - let p = System.Diagnostics.Process.Start psi - - // Wait for the process to finish - p.WaitForExit() - - check "Process.Start" p.ExitCode // TODO: really need to check against 0 - - // Conversion was successful, so read the object file - objBytes <- FileSystem.ReadAllBytesShim tempObjFileName - //Array.Copy(objBytes, pbUnlinkedResource, pbUnlinkedResource.Length) - FileSystem.FileDelete tempObjFileName - finally - // clean up the temp files - List.iter (fun tempResFileName -> FileSystem.FileDelete tempResFileName) tempResFiles - - // Part 2: Read the COFF file held in pbUnlinkedResource, spit it out into pResBuffer and apply the COFF fixups - // pResBuffer will become the .rsrc section of the PE file - if (objBytes = Unchecked.defaultof) then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - let hMod = bytesToIFH objBytes 0 - - if hMod.SizeOfOptionalHeader <> 0s then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - let rsrc01Name = 0x313024637273722eL // ".rsrc$01" - let rsrc02Name = 0x323024637273722eL // ".rsrc$02" - let nullHdr = Unchecked.defaultof - let mutable rsrc01 = nullHdr - let mutable rsrc02 = nullHdr - - for i = 0 to int hMod.NumberOfSections do - let pSection = bytesToISH objBytes (IMAGE_FILE_HEADER.Width + (IMAGE_SECTION_HEADER.Width * i)) - if pSection.Name = rsrc01Name then - rsrc01 <- pSection - else if pSection.Name = rsrc02Name then - rsrc02 <- pSection - - if (nullHdr = rsrc01) || (nullHdr = rsrc02) then - // One of the rsrc sections wasn't found - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - let size = rsrc01.SizeOfRawData + rsrc02.SizeOfRawData - - let pResBuffer = Bytes.zeroCreate size - - // Copy over the raw data - Bytes.blit objBytes rsrc01.PointerToRawData pResBuffer 0 rsrc01.SizeOfRawData - - // map all the relocs in .rsrc$01 using the reloc and symbol tables in the COFF object - let symbolTableHead = hMod.PointerToSymbolTable - let IMAGE_SYM_CLASS_STATIC = 0x3uy - let IMAGE_SYM_TYPE_NULL = 0x0s - - let GetSymbolEntry (buffer: byte[]) (idx: int) = - bytesToIS buffer (symbolTableHead + (idx * IMAGE_SYMBOL.Width) ) - - for iReloc = 0 to int (rsrc01.NumberOfRelocations - 1s) do - let pReloc = bytesToIR objBytes (rsrc01.PointerToRelocations + (iReloc * IMAGE_RELOCATION.Width)) - let IdxSymbol = pReloc.SymbolTableIndex - let pSymbolEntry = GetSymbolEntry objBytes IdxSymbol - - // Ensure the symbol entry is valid for a resource - if ((pSymbolEntry.StorageClass <> IMAGE_SYM_CLASS_STATIC) || - (pSymbolEntry.Type <> IMAGE_SYM_TYPE_NULL) || - (pSymbolEntry.SectionNumber <> 3s)) then - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - // Ensure that RVA is a valid address inside rsrc02 - if pSymbolEntry.Value >= rsrc02.SizeOfRawData then - // pSymbolEntry.Value is too big - System.Runtime.InteropServices.Marshal.ThrowExceptionForHR(E_FAIL) - - // store the value - let vBuff, vSize = dwToBytes (ulLinkedResourceBaseRVA + rsrc01.SizeOfRawData + pSymbolEntry.Value) - //Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer pReloc.VirtualAddress rsrc02.SizeOfRawData - Bytes.blit vBuff 0 pResBuffer pReloc.VirtualAddress vSize - // Copy $02 (resource raw into pResBuffer - Bytes.blit objBytes rsrc02.PointerToRawData pResBuffer rsrc01.SizeOfRawData rsrc02.SizeOfRawData - - // return the buffer - pResBuffer +let linkNativeResources (unlinkedResources: byte[] list) (ulLinkedResourceBaseRVA: int32) = + let resources = + unlinkedResources + |> Seq.map (fun s -> new MemoryStream(s)) + |> Seq.map (fun s -> + let res = CvtResFile.ReadResFile s + s.Dispose() + res) + |> Seq.collect id + // See MakeWin32ResourceList https://github.com/dotnet/roslyn/blob/f40b89234db51da1e1153c14af184e618504be41/src/Compilers/Core/Portable/Compilation/Compilation.cs + |> Seq.map (fun r -> + Win32Resource(data = r.data, codePage = 0u, languageId = uint32 r.LanguageId, + id = int (int16 r.pstringName.Ordinal), name = r.pstringName.theString, + typeId = int (int16 r.pstringType.Ordinal), typeName = r.pstringType.theString)) + let bb = new System.Reflection.Metadata.BlobBuilder() + NativeResourceWriter.SerializeWin32Resources(bb, resources, ulLinkedResourceBaseRVA) + bb.ToArray() let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = let mutable nResNodes = 0 @@ -843,7 +691,6 @@ let unlinkResource (ulLinkedResourceBaseRVA: int32) (pbLinkedResource: byte[]) = resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset) pResBuffer -#endif #if !FX_NO_PDB_WRITER // PDB Writing diff --git a/src/absil/ilsupp.fsi b/src/absil/ilsupp.fsi index 48e7de602b..a32cdb605f 100755 --- a/src/absil/ilsupp.fsi +++ b/src/absil/ilsupp.fsi @@ -29,20 +29,14 @@ open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.IL -#if !FX_NO_LINKEDRESOURCES type IStream = System.Runtime.InteropServices.ComTypes.IStream -#endif /// Unmanaged resource file linker - for native resources (not managed ones). /// The function may be called twice, once with a zero-RVA and /// arbitrary buffer, and once with the real buffer. The size of the /// required buffer is returned. -type PEFileType = X86 | X64 - -#if !FX_NO_LINKEDRESOURCES -val linkNativeResources: unlinkedResources:byte[] list -> rva:int32 -> PEFileType -> tempFilePath:string -> byte[] +val linkNativeResources: unlinkedResources:byte[] list -> rva:int32 -> byte[] val unlinkResource: int32 -> byte[] -> byte[] -#endif #if !FX_NO_PDB_WRITER /// PDB reader and associated types diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index e9978c3de5..2a8b4343f9 100755 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -3037,9 +3037,6 @@ module FileSystemUtilites = open System open System.Reflection open System.Globalization -#if FX_RESHAPED_REFLECTION - open Microsoft.FSharp.Core.ReflectionAdapters -#endif let progress = try System.Environment.GetEnvironmentVariable("FSharp_DebugSetFilePermissions") <> null with _ -> false let setExecutablePermission (filename: string) = @@ -3732,40 +3729,27 @@ let writeBinaryAndReportMappings (outfile, let nextPhys = align alignPhys (textSectionPhysLoc + textSectionSize) let textSectionPhysSize = nextPhys - textSectionPhysLoc let next = align alignVirt (textSectionAddr + textSectionSize) - - // .RSRC SECTION (DATA) + + // .RSRC SECTION (DATA) let dataSectionPhysLoc = nextPhys let dataSectionAddr = next let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc - - let resourceFormat = if modul.Is64Bit then Support.X64 else Support.X86 - - let nativeResources = + let nativeResources = match modul.NativeResources with | [] -> [||] | resources -> -#if ENABLE_MONO_SUPPORT - if runningOnMono then - [||] - else -#endif -#if FX_NO_LINKEDRESOURCES - ignore resources - ignore resourceFormat - [||] -#else - let unlinkedResources = - resources |> List.map (function - | ILNativeResource.Out bytes -> bytes - | ILNativeResource.In (fileName, linkedResourceBase, start, len) -> - let linkedResource = File.ReadBinaryChunk (fileName, start, len) - unlinkResource linkedResourceBase linkedResource) - - begin - try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName outfile) - with e -> failwith ("Linking a native resource failed: "+e.Message+"") - end -#endif + let unlinkedResources = + resources |> List.map (function + | ILNativeResource.Out bytes -> bytes + | ILNativeResource.In (fileName, linkedResourceBase, start, len) -> + let linkedResource = File.ReadBinaryChunk (fileName, start, len) + unlinkResource linkedResourceBase linkedResource) + + begin + try linkNativeResources unlinkedResources next + with e -> failwith ("Linking a native resource failed: "+e.Message+"") + end + let nativeResourcesSize = nativeResources.Length let nativeResourcesChunk, next = chunk nativeResourcesSize next @@ -4169,14 +4153,12 @@ let writeBinaryAndReportMappings (outfile, writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize) - // DATA SECTION -#if !FX_NO_LINKEDRESOURCES + // DATA SECTION match nativeResources with | [||] -> () | resources -> write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |] writeBytes os resources -#endif if dummydatap.size <> 0x0 then write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |] diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index 86b7ee9224..90d53444e7 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -203,7 +203,7 @@ let pdbChecksumDebugInfo timestamp (checksumPdbChunk: BinaryChunk) (algorithmNam buffer { iddCharacteristics = 0 // Reserved iddMajorVersion = 1 // VersionMajor should be 1 - iddMinorVersion = 0x0100 // VersionMinor should be 0x0100 + iddMinorVersion = 0 // VersionMinor should be 0 iddType = 19 // IMAGE_DEBUG_TYPE_CHECKSUMPDB iddTimestamp = timestamp iddData = iddBuffer // Path name to the pdb file when built diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 5b75cf1077..239015820a 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -29,6 +29,7 @@ open FSharp.Compiler.AttributeChecking open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticMessage open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.Lexhelp @@ -1740,7 +1741,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt let os = System.Text.StringBuilder() OutputPhasedDiagnostic os err flattenErrors canSuggestNames errors.Add( Diagnostic.Short(isError, os.ToString()) ) - + relatedErrors |> List.iter OutputRelatedError match err with @@ -1790,7 +1791,7 @@ let OutputDiagnosticContext prefix fileLineFn os err = let (++) x s = x @ [s] -//---------------------------------------------------------------------------- +//-------------------------------------------------------------------------- // General file name resolver //-------------------------------------------------------------------------- @@ -1975,7 +1976,7 @@ type ICompilationThread = /// Enqueue work to be done on a compilation thread. abstract EnqueueWork: (CompilationThreadToken -> unit) -> unit -type ImportedBinary = +type ImportedBinary = { FileName: string RawMetadata: IRawFSharpAssemblyData #if !NO_EXTENSIONTYPING @@ -1986,7 +1987,7 @@ type ImportedBinary = ILAssemblyRefs: ILAssemblyRef list ILScopeRef: ILScopeRef } -type ImportedAssembly = +type ImportedAssembly = { ILScopeRef: ILScopeRef FSharpViewOfMetadata: CcuThunk AssemblyAutoOpenAttributes: string list @@ -2001,7 +2002,7 @@ type AvailableImportedAssembly = | ResolvedImportedAssembly of ImportedAssembly | UnresolvedImportedAssembly of string -type CcuLoadFailureAction = +type CcuLoadFailureAction = | RaiseError | ReturnNone @@ -2015,9 +2016,6 @@ type TcConfigBuilder = mutable openDebugInformationForLaterStaticLinking: bool (* only for --standalone *) defaultFSharpBinariesDir: string mutable compilingFslib: bool - mutable compilingFslib20: string option - mutable compilingFslib40: bool - mutable compilingFslibNoBigInt: bool mutable useIncrementalBuilder: bool mutable includes: string list mutable implicitOpens: string list @@ -2164,8 +2162,10 @@ type TcConfigBuilder = mutable internalTestSpanStackReferring: bool mutable noConditionalErasure: bool - + mutable pathMap: PathMap + + mutable langVersion: LanguageVersion } static member Initial = @@ -2180,9 +2180,6 @@ type TcConfigBuilder = openDebugInformationForLaterStaticLinking = false defaultFSharpBinariesDir = String.Empty compilingFslib = false - compilingFslib20 = None - compilingFslib40 = false - compilingFslibNoBigInt = false useIncrementalBuilder = false useFsiAuxLib = false implicitOpens = [] @@ -2211,7 +2208,7 @@ type TcConfigBuilder = debuginfo = false testFlagEmitFeeFeeAs100001 = false dumpDebugInfo = false - debugSymbolFile = None + debugSymbolFile = None (* Backend configuration *) typeCheckOnly = false @@ -2306,6 +2303,7 @@ type TcConfigBuilder = internalTestSpanStackReferring = false noConditionalErasure = false pathMap = PathMap.empty + langVersion = LanguageVersion("default") } static member CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, reduceMemoryUsage, implicitIncludeDir, @@ -2574,35 +2572,22 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let filename = ComputeMakePathAbsolute data.implicitIncludeDir r.Text if FileSystem.SafeExists filename then r, Some filename - else + else // If the file doesn't exist, let reference resolution logic report the error later... defaultCoreLibraryReference, if Range.equals r.Range rangeStartup then Some(filename) else None match data.referencedDLLs |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with - | [r] -> nameOfDll r - | [] -> - defaultCoreLibraryReference, None - | r :: _ -> - // Recover by picking the first one. - errorR(Error(FSComp.SR.buildMultipleReferencesNotAllowed libraryName, rangeCmdArgs)) - nameOfDll r + | [] -> defaultCoreLibraryReference, None + | [r] + | r :: _ -> nameOfDll r - // Look for an explicit reference to mscorlib and use that to compute clrRoot and targetFrameworkVersion + // Look for an explicit reference to mscorlib/netstandard.dll or System.Runtime.dll and use that to compute clrRoot and targetFrameworkVersion let primaryAssemblyReference, primaryAssemblyExplicitFilenameOpt = computeKnownDllReference(data.primaryAssembly.Name) - let fslibReference, fslibExplicitFilenameOpt = - let (_, fileNameOpt) as res = computeKnownDllReference getFSharpCoreLibraryName + let fslibReference = + // Look for explict FSharp.Core reference otherwise use version that was referenced by compiler + let dllReference, fileNameOpt = computeKnownDllReference getFSharpCoreLibraryName match fileNameOpt with - | None -> - // if FSharp.Core was not provided explicitly - use version that was referenced by compiler - AssemblyReference(range0, getDefaultFSharpCoreReference, None), None - | _ -> res - - // If either mscorlib.dll/System.Runtime.dll/netstandard.dll or FSharp.Core.dll are explicitly specified then we require the --noframework flag. - // The reason is that some non-default frameworks may not have the default dlls. For example, Client profile does - // not have System.Web.dll. - do if ((primaryAssemblyExplicitFilenameOpt.IsSome || fslibExplicitFilenameOpt.IsSome) && data.framework) then - error(Error(FSComp.SR.buildExplicitCoreLibRequiresNoFramework("--noframework"), rangeStartup)) - - let ilGlobals = mkILGlobals ILScopeRef.Local + | Some _ -> dllReference + | None -> AssemblyReference(range0, getDefaultFSharpCoreReference, None) // clrRoot: the location of the primary assembly (mscorlib.dll or netstandard.dll or System.Runtime.dll) // @@ -2633,41 +2618,14 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = let systemAssemblies = systemAssemblies - // Look for an explicit reference to FSharp.Core and use that to compute fsharpBinariesDir - // FUTURE: remove this, we only read the binary for the exception it raises - let fsharpBinariesDirValue = -// NOTE: It's not clear why this behaviour has been changed for the NETSTANDARD compilations of the F# compiler -#if NETSTANDARD - ignore ilGlobals - data.defaultFSharpBinariesDir -#else - match fslibExplicitFilenameOpt with - | Some fslibFilename -> - let filename = ComputeMakePathAbsolute data.implicitIncludeDir fslibFilename - if fslibReference.ProjectReference.IsNone then - try - use ilReader = OpenILBinary(filename, data.reduceMemoryUsage, ilGlobals, None, data.shadowCopyReferences, data.tryGetMetadataSnapshot) - () - with e -> - error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) - - let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim filename) - fslibRoot - | _ -> - data.defaultFSharpBinariesDir -#endif - member x.primaryAssembly = data.primaryAssembly member x.autoResolveOpenDirectivesToDlls = data.autoResolveOpenDirectivesToDlls member x.noFeedback = data.noFeedback member x.stackReserveSize = data.stackReserveSize member x.implicitIncludeDir = data.implicitIncludeDir member x.openDebugInformationForLaterStaticLinking = data.openDebugInformationForLaterStaticLinking - member x.fsharpBinariesDir = fsharpBinariesDirValue + member x.fsharpBinariesDir = data.defaultFSharpBinariesDir member x.compilingFslib = data.compilingFslib - member x.compilingFslib20 = data.compilingFslib20 - member x.compilingFslib40 = data.compilingFslib40 - member x.compilingFslibNoBigInt = data.compilingFslibNoBigInt member x.useIncrementalBuilder = data.useIncrementalBuilder member x.includes = data.includes member x.implicitOpens = data.implicitOpens @@ -2756,6 +2714,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member x.emitTailcalls = data.emitTailcalls member x.deterministic = data.deterministic member x.pathMap = data.pathMap + member x.langVersion = data.langVersion member x.preferredUiLang = data.preferredUiLang member x.lcid = data.lcid member x.optsOn = data.optsOn @@ -3133,7 +3092,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member tcConfig.PrimaryAssemblyDllReference() = primaryAssemblyReference member tcConfig.CoreLibraryDllReference() = fslibReference - + let ReportWarning options err = warningOn err (options.WarnLevel) (options.WarnOn) && not (List.contains (GetDiagnosticNumber err) (options.WarnOff)) @@ -3484,8 +3443,8 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, conditionalCompil if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then if not(FileSystem.SafeExists filename) then error(Error(FSComp.SR.buildCouldNotFindSourceFile filename, rangeStartup)) - // bug 3155: if the file name is indirect, use a full path - let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(filename, tcConfig.inputCodePage, retryLocked) + let isFeatureSupported featureId = tcConfig.langVersion.SupportsFeature featureId + let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(isFeatureSupported, filename, tcConfig.inputCodePage, retryLocked) ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) else error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir), rangeStartup)) with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None @@ -4729,7 +4688,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse let tcGlobals = TcGlobals(tcConfig.compilingFslib, ilGlobals, fslibCcu, tcConfig.implicitIncludeDir, tcConfig.mlCompatibility, tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, - tcConfig.noDebugData, tcConfig.pathMap) + tcConfig.noDebugData, tcConfig.pathMap, tcConfig.langVersion) #if DEBUG // the global_g reference cell is used only for debug printing @@ -4784,7 +4743,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. -let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) = +let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file, assemblyReferenceAdded: string -> unit) = let resolutions = CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, AssemblyReference(m, file, None), ResolveAssemblyReferenceMode.ReportErrors)) let dllinfos, ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> Cancellable.runWithoutCancellation @@ -4795,7 +4754,13 @@ let RequireDLL (ctok, tcImports: TcImports, tcEnv, thisAssemblyName, m, file) = let g = tcImports.GetTcGlobals() let amap = tcImports.GetImportMap() - let tcEnv = (tcEnv, asms) ||> List.fold (fun tcEnv asm -> AddCcuToTcEnv(g, amap, m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm.AssemblyInternalsVisibleToAttributes)) + let buildTcEnv tcEnv asm = + let tcEnv = AddCcuToTcEnv(g, amap, m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm.AssemblyInternalsVisibleToAttributes) + match asm.FSharpViewOfMetadata.FileName with + | Some asmPath -> assemblyReferenceAdded asmPath + | None -> () + tcEnv + let tcEnv = (tcEnv, asms) ||> List.fold buildTcEnv tcEnv, (dllinfos, asms) @@ -5008,11 +4973,13 @@ module private ScriptPreprocessClosure = | CodeContext.CompilationAndEvaluation -> ["INTERACTIVE"] | CodeContext.Compilation -> ["COMPILED"] | CodeContext.Editing -> "EDITING" :: (if IsScript filename then ["INTERACTIVE"] else ["COMPILED"]) - let lexbuf = UnicodeLexing.SourceTextAsLexbuf(sourceText) - + + let isFeatureSupported featureId = tcConfig.langVersion.SupportsFeature featureId + let lexbuf = UnicodeLexing.SourceTextAsLexbuf(isFeatureSupported, sourceText) + let isLastCompiland = (IsScript filename), tcConfig.target.IsExe // The root compiland is last in the list of compilands. ParseOneInputLexbuf (tcConfig, lexResourceManager, defines, lexbuf, filename, isLastCompiland, errorLogger) - + /// Create a TcConfig for load closure starting from a single .fsx file let CreateScriptTextTcConfig (legacyReferenceResolver, defaultFSharpBinariesDir, @@ -5224,7 +5191,7 @@ module private ScriptPreprocessClosure = useSimpleResolution, useFsiAuxLib, useSdkRefs, lexResourceManager: Lexhelp.LexResourceManager, applyCommmandLineArgs, assumeDotNetFramework, - tryGetMetadataSnapshot, reduceMemoryUsage) = + tryGetMetadataSnapshot, reduceMemoryUsage) = // Resolve the basic references such as FSharp.Core.dll first, before processing any #I directives in the script // @@ -5322,11 +5289,8 @@ let CheckSimulateException(tcConfig: TcConfig) = | Some("tc-oom") -> raise(System.OutOfMemoryException()) | Some("tc-an") -> raise(System.ArgumentNullException("simulated")) | Some("tc-invop") -> raise(System.InvalidOperationException()) -#if FX_REDUCED_EXCEPTIONS -#else | Some("tc-av") -> raise(System.AccessViolationException()) | Some("tc-nfn") -> raise(System.NotFiniteNumberException()) -#endif | Some("tc-aor") -> raise(System.ArgumentOutOfRangeException()) | Some("tc-dv0") -> raise(System.DivideByZeroException()) | Some("tc-oe") -> raise(System.OverflowException()) diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 1262542cd9..34e25a21f1 100644 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -17,6 +17,7 @@ open FSharp.Compiler.TypeChecker open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Tast open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -256,9 +257,6 @@ type TcConfigBuilder = mutable openDebugInformationForLaterStaticLinking: bool defaultFSharpBinariesDir: string mutable compilingFslib: bool - mutable compilingFslib20: string option - mutable compilingFslib40: bool - mutable compilingFslibNoBigInt: bool mutable useIncrementalBuilder: bool mutable includes: string list mutable implicitOpens: string list @@ -386,6 +384,8 @@ type TcConfigBuilder = mutable noConditionalErasure: bool mutable pathMap : PathMap + + mutable langVersion : LanguageVersion } static member Initial: TcConfigBuilder @@ -424,9 +424,6 @@ type TcConfig = member openDebugInformationForLaterStaticLinking: bool member fsharpBinariesDir: string member compilingFslib: bool - member compilingFslib20: string option - member compilingFslib40: bool - member compilingFslibNoBigInt: bool member useIncrementalBuilder: bool member includes: string list member implicitOpens: string list @@ -549,6 +546,7 @@ type TcConfig = member copyFSharpCore: CopyFSharpCoreFlag member shadowCopyReferences: bool member useSdkRefs: bool + member langVersion: LanguageVersion static member Create: TcConfigBuilder * validate: bool -> TcConfig @@ -678,7 +676,7 @@ val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk /// 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 * assemblyReferenceAdded: (string -> unit) -> TcEnv * (ImportedBinary list * ImportedAssembly list) /// Processing # commands val ProcessMetaCommandsFromInput: diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index e548a49e71..c4595d2dc2 100755 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -18,6 +18,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.Tast open FSharp.Compiler.Tastops open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Lib open FSharp.Compiler.Range open FSharp.Compiler.IlxGen @@ -527,6 +528,7 @@ let tagAlgorithm = "{SHA1|SHA256}" let tagInt = "" let tagPathMap = "" let tagNone = "" +let tagLangVersionValues = "{?|version|latest|preview}" // PrintOptionInfo //---------------- @@ -814,28 +816,41 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) = //---------------------- let defineSymbol tcConfigB s = tcConfigB.conditionalCompilationDefines <- s :: tcConfigB.conditionalCompilationDefines - + let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) = CompilerOption ("mlcompatibility", tagNone, OptionUnit (fun () -> tcConfigB.mlCompatibility<-true; tcConfigB.TurnWarningOff(rangeCmdArgs, "62")), None, Some (FSComp.SR.optsMlcompatibility())) +/// LanguageVersion management +let setLanguageVersion (specifiedVersion) = + + let languageVersion = new LanguageVersion(specifiedVersion) + let dumpAllowedValues () = + printfn "%s" (FSComp.SR.optsSupportedLangVersions()) + for v in languageVersion.ValidOptions do printfn "%s" v + for v in languageVersion.ValidVersions do printfn "%s" v + exit 0 + + if specifiedVersion = "?" then dumpAllowedValues () + if not (languageVersion.ContainsVersion specifiedVersion) then error(Error(FSComp.SR.optsUnrecognizedLanguageVersion specifiedVersion, rangeCmdArgs)) + languageVersion + let languageFlags tcConfigB = [ - CompilerOption - ("checked", tagNone, - OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None, - Some (FSComp.SR.optsChecked())) - - CompilerOption - ("define", tagString, - OptionString (defineSymbol tcConfigB), None, - Some (FSComp.SR.optsDefine())) - + // -langversion:? Display the allowed values for language version + // -langversion: Specify language version such as + // 'default' (latest major version), or + // 'latest' (latest version, including minor versions), + // 'preview' (features for preview) + // or specific versions like '4.7' + CompilerOption("langversion", tagLangVersionValues, OptionString (fun switch -> tcConfigB.langVersion <- setLanguageVersion(switch)), None, Some (FSComp.SR.optsLangVersion())) + + CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None, Some (FSComp.SR.optsChecked())) + CompilerOption("define", tagString, OptionString (defineSymbol tcConfigB), None, Some (FSComp.SR.optsDefine())) mlCompatibilityFlag tcConfigB ] - // OptionBlock: Advanced user options //----------------------------------- @@ -1217,10 +1232,9 @@ let internalFlags (tcConfigB:TcConfigBuilder) = Some(InternalCommandLineOption("metadataversion", rangeCmdArgs)), None) ] - // OptionBlock: Deprecated flags (fsc, service only) //-------------------------------------------------- - + let compilingFsLibFlag (tcConfigB: TcConfigBuilder) = CompilerOption ("compiling-fslib", tagNone, @@ -1231,23 +1245,14 @@ let compilingFsLibFlag (tcConfigB: TcConfigBuilder) = IlxSettings.ilxCompilingFSharpCoreLib := true), Some(InternalCommandLineOption("--compiling-fslib", rangeCmdArgs)), None) -let compilingFsLib20Flag (tcConfigB: TcConfigBuilder) = - CompilerOption - ("compiling-fslib-20", tagNone, - OptionString (fun s -> tcConfigB.compilingFslib20 <- Some s ), - Some(InternalCommandLineOption("--compiling-fslib-20", rangeCmdArgs)), None) +let compilingFsLib20Flag = + CompilerOption ("compiling-fslib-20", tagNone, OptionString (fun _ -> () ), None, None) -let compilingFsLib40Flag (tcConfigB: TcConfigBuilder) = - CompilerOption - ("compiling-fslib-40", tagNone, - OptionUnit (fun () -> tcConfigB.compilingFslib40 <- true ), - Some(InternalCommandLineOption("--compiling-fslib-40", rangeCmdArgs)), None) +let compilingFsLib40Flag = + CompilerOption ("compiling-fslib-40", tagNone, OptionUnit (fun () -> ()), None, None) -let compilingFsLibNoBigIntFlag (tcConfigB: TcConfigBuilder) = - CompilerOption - ("compiling-fslib-nobigint", tagNone, - OptionUnit (fun () -> tcConfigB.compilingFslibNoBigInt <- true ), - Some(InternalCommandLineOption("--compiling-fslib-nobigint", rangeCmdArgs)), None) +let compilingFsLibNoBigIntFlag = + CompilerOption ("compiling-fslib-nobigint", tagNone, OptionUnit (fun () -> () ), None, None) let mlKeywordsFlag = CompilerOption @@ -1262,7 +1267,7 @@ let gnuStyleErrorsFlag tcConfigB = Some(DeprecatedCommandLineOptionNoDescription("--gnu-style-errors", rangeCmdArgs)), None) let deprecatedFlagsBoth tcConfigB = - [ + [ CompilerOption ("light", tagNone, OptionUnit (fun () -> tcConfigB.light <- Some true), @@ -1278,7 +1283,7 @@ let deprecatedFlagsBoth tcConfigB = OptionUnit (fun () -> tcConfigB.light <- Some false), Some(DeprecatedCommandLineOptionNoDescription("--no-indentation-syntax", rangeCmdArgs)), None) ] - + let deprecatedFlagsFsi tcConfigB = deprecatedFlagsBoth tcConfigB let deprecatedFlagsFsc tcConfigB = @@ -1311,9 +1316,9 @@ let deprecatedFlagsFsc tcConfigB = Some(DeprecatedCommandLineOptionNoDescription("--progress", rangeCmdArgs)), None) compilingFsLibFlag tcConfigB - compilingFsLib20Flag tcConfigB - compilingFsLib40Flag tcConfigB - compilingFsLibNoBigIntFlag tcConfigB + compilingFsLib20Flag + compilingFsLib40Flag + compilingFsLibNoBigIntFlag CompilerOption ("version", tagString, @@ -1616,16 +1621,10 @@ let ReportTime (tcConfig:TcConfig) descr = | Some("fsc-oom") -> raise(System.OutOfMemoryException()) | Some("fsc-an") -> raise(System.ArgumentNullException("simulated")) | Some("fsc-invop") -> raise(System.InvalidOperationException()) -#if FX_REDUCED_EXCEPTIONS -#else | Some("fsc-av") -> raise(System.AccessViolationException()) -#endif | Some("fsc-aor") -> raise(System.ArgumentOutOfRangeException()) | Some("fsc-dv0") -> raise(System.DivideByZeroException()) -#if FX_REDUCED_EXCEPTIONS -#else | Some("fsc-nfn") -> raise(System.NotFiniteNumberException()) -#endif | Some("fsc-oe") -> raise(System.OverflowException()) | Some("fsc-atmm") -> raise(System.ArrayTypeMismatchException()) | Some("fsc-bif") -> raise(System.BadImageFormatException()) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 1cb860abae..6fd557981f 100755 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -2730,9 +2730,26 @@ let UndoIfFailed f = ReportWarnings warns true +let UndoIfFailedOrWarnings f = + let trace = Trace.New() + let res = + try + f trace + |> CheckNoErrorsAndGetWarnings + with e -> None + match res with + | Some [] -> + true + | _ -> + trace.Undo() + false + let AddCxTypeEqualsTypeUndoIfFailed denv css m ty1 ty2 = UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2) +let AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv css m ty1 ty2 = + UndoIfFailedOrWarnings (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2) + let AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = let csenv = { MakeConstraintSolverEnv ContextInfo.NoContext css m denv with MatchingOnly = true } UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 59c271b126..1fce009f61 100755 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -126,6 +126,7 @@ val CheckDeclaredTypars : DisplayEnv -> ConstraintSolverSt val AddConstraint : ConstraintSolverEnv -> int -> Range.range -> OptionalTrace -> Typar -> TyparConstraint -> OperationResult val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool +val AddCxTypeEqualsTypeUndoIfFailedOrWarnings : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool diff --git a/src/fsharp/DotNetFrameworkDependencies.fs b/src/fsharp/DotNetFrameworkDependencies.fs index 504bde5fa3..2e96dcd367 100644 --- a/src/fsharp/DotNetFrameworkDependencies.fs +++ b/src/fsharp/DotNetFrameworkDependencies.fs @@ -82,7 +82,10 @@ module internal FSharp.Compiler.DotNetFrameworkDependencies let file = try let depsJsonPath = Path.ChangeExtension(Assembly.GetEntryAssembly().Location, "deps.json") - File.ReadAllText(depsJsonPath) + if File.Exists(depsJsonPath) then + File.ReadAllText(depsJsonPath) + else + "" with _ -> "" let tfmPrefix=".NETCoreApp,Version=v" @@ -179,7 +182,6 @@ module internal FSharp.Compiler.DotNetFrameworkDependencies // (a) included in the environment used for all .fsx files (see service.fs) // (b) included in environment for files 'orphaned' from a project context // -- for orphaned files (files in VS without a project context) - // -- for files given on a command line without --noframework set let getDesktopDefaultReferences useFsiAuxLib = [ yield "mscorlib" yield "System" diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 2f9c07173b..5760aef8a2 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -351,10 +351,6 @@ module ErrorLoggerExtensions = /// Reraise an exception if it is one we want to report to Watson. let ReraiseIfWatsonable(exn:exn) = -#if FX_REDUCED_EXCEPTIONS - ignore exn - () -#else match exn with // These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs | :? System.Reflection.TargetInvocationException -> () @@ -366,7 +362,6 @@ module ErrorLoggerExtensions = PreserveStackTrace exn raise exn | _ -> () -#endif type ErrorLogger with @@ -404,10 +399,7 @@ module ErrorLoggerExtensions = // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. match exn with (* Don't send ThreadAbortException down the error channel *) -#if FX_REDUCED_EXCEPTIONS -#else | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException), _) -> () -#endif | ReportedError _ | WrappedError(ReportedError _, _) -> () | StopProcessing | WrappedError(StopProcessing, _) -> PreserveStackTrace exn @@ -679,7 +671,7 @@ type public FSharpErrorSeverityOptions = // See https://github.com/Microsoft/visualfsharp/issues/6417, if a compile of the FSharp.Compiler.Services.dll or other compiler -// binary produces exactly 65536 methods then older versions of the compiler raise a bug. If you hit this bug again then try removing -// this. -let dummyMethodFOrBug6417A() = () -let dummyMethodFOrBug6417B() = () +// binary produces exactly 65536 methods then older versions of the compiler raise a bug. If you hit this bug again then try adding +// this back in. +// let dummyMethodFOrBug6417A() = () +// let dummyMethodFOrBug6417B() = () diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index 0513bcf2ee..c075e0dbe9 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -140,9 +140,7 @@ module internal ExtensionTyping = let StripException (e: exn) = match e with -#if !FX_REDUCED_EXCEPTIONS | :? System.Reflection.TargetInvocationException as e -> e.InnerException -#endif | :? TypeInitializationException as e -> e.InnerException | _ -> e @@ -417,6 +415,7 @@ module internal ExtensionTyping = member __.IsEnum = x.IsEnum member __.IsClass = x.IsClass member __.IsSealed = x.IsSealed + member __.IsAbstract = x.IsAbstract member __.IsInterface = x.IsInterface member __.GetArrayRank() = x.GetArrayRank() member __.GenericParameterPosition = x.GenericParameterPosition diff --git a/src/fsharp/ExtensionTyping.fsi b/src/fsharp/ExtensionTyping.fsi index 5049fffa77..5c679fe69e 100755 --- a/src/fsharp/ExtensionTyping.fsi +++ b/src/fsharp/ExtensionTyping.fsi @@ -120,6 +120,7 @@ module internal ExtensionTyping = member IsInterface : bool member IsClass : bool member IsSealed : bool + member IsAbstract : bool member IsPublic : bool member IsNestedPublic : bool member GenericParameterPosition : int diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index 831597c031..c1ab22ab6a 100755 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -43,7 +43,6 @@ buildProductNameCommunity,"F# Compiler for F# %s" 212,buildInvalidFilename,"'%s' is not a valid filename" 213,buildInvalidAssemblyName,"'%s' is not a valid assembly name" 214,buildInvalidPrivacy,"Unrecognized privacy setting '%s' for managed resource, valid options are 'public' and 'private'" -215,buildMultipleReferencesNotAllowed,"Multiple references to '%s.dll' are not permitted" 218,buildCannotReadAssembly,"Unable to read assembly '%s'" 220,buildAssemblyResolutionFailed,"Assembly resolution failure at or near this location" 221,buildImplicitModuleIsNotLegalIdentifier,"The declarations in this file will be placed in an implicit module '%s' based on the file name '%s'. However this is not a valid F# identifier, so the contents will not be accessible from other files. Consider renaming the file or adding a 'module' or 'namespace' declaration at the top of the file." @@ -73,6 +72,7 @@ buildProductNameCommunity,"F# Compiler for F# %s" pickleErrorReadingWritingMetadata,"Error reading/writing metadata for the F# compiled DLL '%s'. Was the DLL compiled with an earlier version of the F# compiler? (error: '%s')." 245,tastTypeOrModuleNotConcrete,"The type/module '%s' is not a concrete module or type" tastTypeHasAssemblyCodeRepresentation,"The type '%s' has an inline assembly code representation" +246,optsUnrecognizedLanguageVersion,"Unrecognized value '%s' for --langversion use --langversion:? for complete list" 247,tastNamespaceAndModuleWithSameNameInAssembly,"A namespace and a module named '%s' both occur in two parts of this assembly" 248,tastTwoModulesWithSameNameInAssembly,"Two modules named '%s' occur in two parts of this assembly" 249,tastDuplicateTypeDefinitionInAssembly,"Two type definitions named '%s' occur in namespace '%s' in two parts of this assembly" @@ -420,6 +420,7 @@ parsAttributesMustComeBeforeVal,"Attributes should be placed before 'val'" 568,parsAllEnumFieldsRequireValues,"All enum fields must be given values" 569,parsInlineAssemblyCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on inline assembly code types" 571,parsUnexpectedIdentifier,"Unexpected identifier: '%s'" +10,parsUnexpectedSymbolDot,"Unexpected symbol '.' in member definition. Expected 'with', '=' or other token." 572,parsUnionCasesCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation." 573,parsEnumFieldsCannotHaveVisibilityDeclarations,"Accessibility modifiers are not permitted on enumeration fields" parsConsiderUsingSeparateRecordType,"Consider using a separate record type instead" @@ -1085,7 +1086,6 @@ lexIndentOffForML,"Consider using a file with extension '.ml' or '.mli' instead" 1219,tcUnionCaseNameConflictsWithGeneratedType,"The union case named '%s' conflicts with the generated type '%s'" 1220,chkNoReflectedDefinitionOnStructMember,"ReflectedDefinitionAttribute may not be applied to an instance member on a struct type, because the instance member takes an implicit 'this' byref parameter" 1221,tcDllImportNotAllowed,"DLLImport bindings must be static members in a class or function definitions in a module" -1222,buildExplicitCoreLibRequiresNoFramework,"When mscorlib.dll or FSharp.Core.dll is explicitly referenced the %s option must also be passed" 1223,buildExpectedSigdataFile,"FSharp.Core.sigdata not found alongside FSharp.Core. File expected in %s. Consider upgrading to a more recent version of FSharp.Core, where this file is no longer be required." 1225,buildExpectedFileAlongSideFSharpCore,"File '%s' not found alongside FSharp.Core. File expected in %s. Consider upgrading to a more recent version of FSharp.Core, where this file is no longer be required." 1227,buildUnexpectedFileNameCharacter,"Filename '%s' contains invalid character '%s'" @@ -1461,7 +1461,14 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl 3243,parsInvalidAnonRecdExpr,"Invalid anonymous record expression" 3244,parsInvalidAnonRecdType,"Invalid anonymous record type" 3245,tcCopyAndUpdateNeedsRecordType,"The input to a copy-and-update expression that creates an anonymous record must be either an anonymous record or a record" +3246,tcAugmentationsCannotHaveAttributes,"Attributes cannot be applied to type extensions." +3250,expressionHasNoName,"Expression does not have a name." +3251,chkNoFirstClassNameOf,"Using the 'nameof' operator as a first-class function value is not permitted." 3300,chkInvalidFunctionParameterType,"The parameter '%s' has an invalid type '%s'. This is not permitted by the rules of Common IL." 3301,chkInvalidFunctionReturnType,"The function or method has an invalid return type '%s'. This is not permitted by the rules of Common IL." useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)." fSharpBannerVersion,"%s for F# %s" +nativeResourceFormatError,"Stream does not begin with a null resource and is not in '.RES' format." +nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed." +optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'" +optsSupportedLangVersions,"Supported language versions:" diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj new file mode 100644 index 0000000000..d02ae419bc --- /dev/null +++ b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj @@ -0,0 +1,49 @@ + + + + + + + $(MSBuildThisFileDirectory)FSharp.Compiler.LanguageServer.DesignTime.targets + + + + + + + + + + + + + + diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets new file mode 100644 index 0000000000..ea8f3e2866 --- /dev/null +++ b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets @@ -0,0 +1,52 @@ + + + + + true + false + true + true + false + false + false + true + false + true + false + + + + + + + _ComputeTargetFrameworkItems + _PopulateTargetFrameworks + + + + + <_TargetFramework Include="$(TargetFramework)" /> + + + + + + + + + + + + + + diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj index fd6e517e54..0bb0899140 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj +++ b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj @@ -23,6 +23,15 @@ + + + + + + + + + diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs b/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs index e6fa760d1c..48e4b0b405 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs @@ -9,10 +9,18 @@ module FunctionNames = [] let OptionsSet = "options/set" + [] + let TextDocumentPublishDiagnostics = "textDocument/publishDiagnostics" + type Options = - { usePreviewTextHover: bool } + { usePreviewTextHover: bool + usePreviewDiagnostics: bool } static member Default() = - { usePreviewTextHover = false } + { usePreviewTextHover = false + usePreviewDiagnostics = false } + static member AllOn() = + { usePreviewTextHover = true + usePreviewDiagnostics = true } module Extensions = type JsonRpc with diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs b/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs index 97479eef26..264e526fcd 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs @@ -5,8 +5,9 @@ namespace FSharp.Compiler.LanguageServer open Newtonsoft.Json.Linq open Newtonsoft.Json -// Interfaces as defined at https://microsoft.github.io/language-server-protocol/specification. The properties on -// these types are camlCased to match the underlying JSON properties to avoid attributes on every field: +// Interfaces as defined at https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/. +// The properties on these types are camlCased to match the underlying JSON properties to avoid attributes on every +// field: // [] /// Represents a zero-based line and column of a text document. @@ -32,7 +33,7 @@ type Diagnostic = { range: Range severity: int option code: string - source: string option // "F#" + source: string option message: string relatedInformation: DiagnosticRelatedInformation[] option } static member Error = 1 @@ -46,7 +47,7 @@ type PublishDiagnosticsParams = type ClientCapabilities = { workspace: JToken option // TODO: WorkspaceClientCapabilities - textDocument: JToken option // TODO: TextDocumentCapabilities + textDocument: JToken option // TODO: TextDocumentClientCapabilities, publishDiagnostics: { relatedInformation: bool option } experimental: JToken option supportsVisualStudioExtensions: bool option } diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs b/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs index d1e614cb29..453b7f8228 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs @@ -8,8 +8,10 @@ open System.Threading open Newtonsoft.Json.Linq open StreamJsonRpc -// https://microsoft.github.io/language-server-protocol/specification -type Methods(state: State) = +// https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/ +type Methods() = + + let state = State() /// Helper to run Async<'T> with a CancellationToken. let runAsync (cancellationToken: CancellationToken) (computation: Async<'T>) = Async.StartAsTask(computation, cancellationToken=cancellationToken) @@ -29,8 +31,10 @@ type Methods(state: State) = [] initializationOptions: JToken, capabilities: ClientCapabilities, [] trace: string, - [] workspaceFolders: WorkspaceFolder[] + [] workspaceFolders: WorkspaceFolder[], + [] cancellationToken: CancellationToken ) = + state.Initialize rootPath rootUri (fun projectOptions -> TextDocument.PublishDiagnostics(state, projectOptions) |> Async.Start) { InitializeResult.capabilities = ServerCapabilities.DefaultCapabilities() } [] @@ -63,5 +67,6 @@ type Methods(state: State) = ( options: Options ) = - sprintf "got options %A" options |> Console.Error.WriteLine + eprintfn "got options %A" options state.Options <- options + state.InvalidateAllProjects() diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs b/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs index 071ad6b226..28d5e49a58 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs @@ -12,17 +12,17 @@ type Server(sendingStream: Stream, receivingStream: Stream) = let converter = JsonOptionConverter() // special handler to convert between `Option<'T>` and `obj/null`. do formatter.JsonSerializer.Converters.Add(converter) let handler = new HeaderDelimitedMessageHandler(sendingStream, receivingStream, formatter) - let state = State() - let methods = Methods(state) + let methods = Methods() let rpc = new JsonRpc(handler, methods) + do methods.State.JsonRpc <- Some rpc member __.StartListening() = rpc.StartListening() member __.WaitForExitAsync() = async { - do! Async.AwaitEvent (state.Shutdown) - do! Async.AwaitEvent (state.Exit) + do! Async.AwaitEvent (methods.State.Shutdown) + do! Async.AwaitEvent (methods.State.Exit) } interface IDisposable with diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/State.fs b/src/fsharp/FSharp.Compiler.LanguageServer/State.fs index 5ca2d3f845..0812bb9a7f 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/State.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/State.fs @@ -2,11 +2,209 @@ namespace FSharp.Compiler.LanguageServer +open System +open System.Collections.Concurrent +open System.Collections.Generic +open System.Diagnostics +open System.IO +open System.Text.RegularExpressions +open FSharp.Compiler.SourceCodeServices +open StreamJsonRpc + +module internal Solution = + // easy unit testing + let getProjectPaths (solutionContent: string) (solutionDir: string) = + // This looks scary, but is much more lightweight than carrying along MSBuild just to have it parse the solution file. + // + // A valid line in .sln looks like: + // Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ConsoleApp2", "ConsoleApp2\ConsoleApp2.fsproj", "{60A4BE67-7E03-4200-AD38-B0E5E8E049C1}" + // and we're hoping to extract this: ------------------------------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + // + // therefore: + // ^Project text 'Project' at the start of the line + // .* any number of characters + // \"" double quote character (it's doubled up to escape from the raw string literal here) + // ( start of capture group + // [^\""] not a quote + // * many of those + // \.fsproj literal string ".fsproj" + // ) end of capture group + // \"" double quote + let pattern = Regex(@"^Project.*\""([^\""]*\.fsproj)\""") + let lines = solutionContent.Split('\n') + let relativeProjects = + lines + |> Array.map pattern.Match + |> Array.filter (fun m -> m.Success) + |> Array.map (fun m -> m.Groups.[1].Value) + // .sln files by convention uses backslashes, which might not be appropriate at runtime + |> Array.map (fun p -> p.Replace('\\', Path.DirectorySeparatorChar)) + let projects = + relativeProjects + |> Array.map (fun p -> if Path.IsPathRooted(p) then p else Path.Combine(solutionDir, p)) + projects + type State() = + let checker = FSharpChecker.Create() + + let sourceFileToProjectMap = ConcurrentDictionary() + let shutdownEvent = new Event<_>() let exitEvent = new Event<_>() let cancelEvent = new Event<_>() + let projectInvalidatedEvent = new Event<_>() + + let fileChanged (args: FileSystemEventArgs) = + match sourceFileToProjectMap.TryGetValue args.FullPath with + | true, projectOptions -> projectInvalidatedEvent.Trigger(projectOptions) + | false, _ -> () + let fileRenamed (args: RenamedEventArgs) = + match sourceFileToProjectMap.TryGetValue args.FullPath with + | true, projectOptions -> projectInvalidatedEvent.Trigger(projectOptions) + | false, _ -> () + let fileWatcher = new FileSystemWatcher() + do fileWatcher.IncludeSubdirectories <- true + do fileWatcher.Changed.Add(fileChanged) + do fileWatcher.Created.Add(fileChanged) + do fileWatcher.Deleted.Add(fileChanged) + do fileWatcher.Renamed.Add(fileRenamed) + + let execProcess (name: string) (args: string) = + let startInfo = ProcessStartInfo(name, args) + eprintfn "executing: %s %s" name args + startInfo.CreateNoWindow <- true + startInfo.RedirectStandardOutput <- true + startInfo.UseShellExecute <- false + let lines = List() + use proc = new Process() + proc.StartInfo <- startInfo + proc.OutputDataReceived.Add(fun args -> lines.Add(args.Data)) + proc.Start() |> ignore + proc.BeginOutputReadLine() + proc.WaitForExit() + lines.ToArray() + + let linesWithPrefixClean (prefix: string) (lines: string[]) = + lines + |> Array.filter (isNull >> not) + |> Array.map (fun line -> line.TrimStart(' ')) + |> Array.filter (fun line -> line.StartsWith(prefix)) + |> Array.map (fun line -> line.Substring(prefix.Length)) + + let getProjectOptions (rootDir: string) = + if isNull rootDir then [||] + else + fileWatcher.Path <- rootDir + fileWatcher.EnableRaisingEvents <- true + + /// This function is meant to be temporary. Until we figure out what a language server for a project + /// system looks like, we have to guess based on the files we find in the root. + let getProjectOptions (projectPath: string) = + let projectDir = Path.GetDirectoryName(projectPath) + let normalizePath (path: string) = + if Path.IsPathRooted(path) then path + else Path.Combine(projectDir, path) + + // To avoid essentially re-creating a copy of MSBuild alongside this tool, we instead fake a design- + // time build with this project. The output of building this helper project is text that's easily + // parsable. See the helper project for more information. + let reporterProject = Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location), "FSharp.Compiler.LanguageServer.DesignTime.proj") + let detectedTfmSentinel = "DetectedTargetFramework=" + let detectedCommandLineArgSentinel = "DetectedCommandLineArg=" + + let execTfmReporter = + sprintf "build \"%s\" \"/p:ProjectFile=%s\"" reporterProject projectPath + |> execProcess "dotnet" + + let execArgReporter (tfm: string) = + sprintf "build \"%s\" \"/p:ProjectFile=%s\" \"/p:TargetFramework=%s\"" reporterProject projectPath tfm + |> execProcess "dotnet" + + // find the target frameworks + let targetFrameworks = + execTfmReporter + |> linesWithPrefixClean detectedTfmSentinel + + let getArgs (tfm: string) = + execArgReporter tfm + |> linesWithPrefixClean detectedCommandLineArgSentinel + + let tfmAndArgs = + targetFrameworks + |> Array.map (fun tfm -> tfm, getArgs tfm) + + let separateArgs (args: string[]) = + args + |> Array.partition (fun a -> a.StartsWith("-")) + |> (fun (options, files) -> + let normalizedFiles = files |> Array.map normalizePath + options, normalizedFiles) + + // TODO: for now we're only concerned with the first TFM + let _tfm, args = Array.head tfmAndArgs + + let otherOptions, sourceFiles = separateArgs args + + let projectOptions: FSharpProjectOptions = + { ProjectFileName = projectPath + ProjectId = None + SourceFiles = sourceFiles + OtherOptions = otherOptions + ReferencedProjects = [||] // TODO: populate from @(ProjectReference) + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + ExtraProjectInfo = None + Stamp = None } + projectOptions + let topLevelProjects = Directory.GetFiles(rootDir, "*.fsproj") + let watchableProjectPaths = + match topLevelProjects with + | [||] -> + match Directory.GetFiles(rootDir, "*.sln") with + // TODO: what to do with multiple .sln or a combo of .sln/.fsproj? + | [| singleSolution |] -> + let content = File.ReadAllText(singleSolution) + let solutionDir = Path.GetDirectoryName(singleSolution) + Solution.getProjectPaths content solutionDir + | _ -> [||] + | _ -> topLevelProjects + let watchableProjectOptions = + watchableProjectPaths + |> Array.map getProjectOptions + + // associate source files with project options + let watchFile file projectOptions = + sourceFileToProjectMap.AddOrUpdate(file, projectOptions, fun _ _ -> projectOptions) + + for projectOptions in watchableProjectOptions do + // watch .fsproj + watchFile projectOptions.ProjectFileName projectOptions |> ignore + // TODO: watch .deps.json + for sourceFile in projectOptions.SourceFiles do + let sourceFileFullPath = + if Path.IsPathRooted(sourceFile) then sourceFile + else + let projectDir = Path.GetDirectoryName(projectOptions.ProjectFileName) + Path.Combine(projectDir, sourceFile) + watchFile sourceFileFullPath projectOptions |> ignore + + watchableProjectOptions + + member __.Checker = checker + + /// Initialize the LSP at the specified location. According to the spec, `rootUri` is to be preferred over `rootPath`. + member __.Initialize (rootPath: string) (rootUri: DocumentUri) (computeDiagnostics: FSharpProjectOptions -> unit) = + let rootDir = + if not (isNull rootUri) then Uri(rootUri).LocalPath + else rootPath + let projectOptions = getProjectOptions rootDir + projectInvalidatedEvent.Publish.Add computeDiagnostics // compute diagnostics on project invalidation + for projectOption in projectOptions do + computeDiagnostics projectOption // compute initial set of diagnostics [] member __.Shutdown = shutdownEvent.Publish @@ -17,10 +215,19 @@ type State() = [] member __.Cancel = cancelEvent.Publish + [] + member __.ProjectInvalidated = projectInvalidatedEvent.Publish + member __.DoShutdown() = shutdownEvent.Trigger() member __.DoExit() = exitEvent.Trigger() member __.DoCancel() = cancelEvent.Trigger() + member __.InvalidateAllProjects() = + for projectOptions in sourceFileToProjectMap.Values do + projectInvalidatedEvent.Trigger(projectOptions) + member val Options = Options.Default() with get, set + + member val JsonRpc: JsonRpc option = None with get, set diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs b/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs index 0c73796505..489b55ebce 100644 --- a/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs +++ b/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs @@ -2,13 +2,15 @@ namespace FSharp.Compiler.LanguageServer -open System +open System.Threading module TextDocument = + let mutable publishDiagnosticsCancellationTokenSource = new CancellationTokenSource() + let Hover (state: State) (textDocument: TextDocumentIdentifier) (position: Position) = async { - Console.Error.WriteLine("hover at " + position.line.ToString() + "," + position.character.ToString()) + eprintfn "hover at %d, %d" position.line position.character if not state.Options.usePreviewTextHover then return None else let startCol, endCol = @@ -21,10 +23,53 @@ module TextDocument = } } - let PublishDiagnostics(state: State) = + let PublishDiagnostics(state: State, projectOptions: FSharp.Compiler.SourceCodeServices.FSharpProjectOptions) = + // TODO: honor TextDocumentClientCapabilities.publishDiagnostics.relatedInformation + // cancel any existing request to publish diagnostics + publishDiagnosticsCancellationTokenSource.Cancel() + publishDiagnosticsCancellationTokenSource <- new CancellationTokenSource() async { - return { - PublishDiagnosticsParams.uri = "" - diagnostics = [||] - } + if not state.Options.usePreviewDiagnostics then return () + else + eprintfn "starting diagnostics computation" + match state.JsonRpc with + | None -> eprintfn "state.JsonRpc was null; should not be?" + | Some jsonRpc -> + let! results = state.Checker.ParseAndCheckProject projectOptions + let diagnostics = results.Errors + let diagnosticsPerFile = + diagnostics + |> Array.fold (fun state t -> + let existing = Map.tryFind t.FileName state |> Option.defaultValue [] + Map.add t.FileName (t :: existing) state) Map.empty + for sourceFile in projectOptions.SourceFiles do + let diagnostics = + Map.tryFind sourceFile diagnosticsPerFile + |> Option.defaultValue [] + |> List.map (fun d -> + // F# errors count lines starting at 1, but LSP starts at 0 + let range: Range = + { start = { line = d.StartLineAlternate - 1; character = d.StartColumn } + ``end`` = { line = d.EndLineAlternate - 1; character = d.EndColumn } } + let severity = + match d.Severity with + | FSharp.Compiler.SourceCodeServices.FSharpErrorSeverity.Warning -> Diagnostic.Warning + | FSharp.Compiler.SourceCodeServices.FSharpErrorSeverity.Error -> Diagnostic.Error + let res: Diagnostic = + { range = range + severity = Some severity + code = "FS" + d.ErrorNumber.ToString("0000") + source = Some d.FileName + message = d.Message + relatedInformation = None } + res) + |> List.toArray + let args: PublishDiagnosticsParams = + { uri = System.Uri(sourceFile).AbsoluteUri + diagnostics = diagnostics } + + // fire each notification separately + jsonRpc.NotifyAsync(TextDocumentPublishDiagnostics, args) |> Async.AwaitTask |> Async.Start } + |> (fun computation -> Async.StartAsTask(computation, cancellationToken=publishDiagnosticsCancellationTokenSource.Token)) + |> Async.AwaitTask diff --git a/src/fsharp/FSharp.Core.nuget/FSharp.Core.nuget.csproj b/src/fsharp/FSharp.Core.nuget/FSharp.Core.nuget.csproj index 512bfaad70..b55bc2feba 100644 --- a/src/fsharp/FSharp.Core.nuget/FSharp.Core.nuget.csproj +++ b/src/fsharp/FSharp.Core.nuget/FSharp.Core.nuget.csproj @@ -2,13 +2,17 @@ true - net45;netstandard1.6 + net45;netstandard2.0 FSharp.Core FSharp.Core.nuspec true FSharp.Core redistributables from Visual F# Tools version $(FSPackageMajorVersion) For F# $(FSCoreMajorVersion). Contains code from the F# Software Foundation. + + + + false diff --git a/src/fsharp/FSharp.Core.nuget/icon.png b/src/fsharp/FSharp.Core.nuget/icon.png new file mode 100644 index 0000000000..8a2b81b9eb Binary files /dev/null and b/src/fsharp/FSharp.Core.nuget/icon.png differ diff --git a/src/fsharp/FSharp.Core/FSCore.resx b/src/fsharp/FSharp.Core/FSCore.resx index 8b74b1d039..b90b5442f2 100644 --- a/src/fsharp/FSharp.Core/FSCore.resx +++ b/src/fsharp/FSharp.Core/FSCore.resx @@ -540,4 +540,7 @@ This is not a valid query expression. The construct '{0}' was used in a query but is not recognized by the F#-to-LINQ query translator. Check the specification of permitted queries and consider moving some of the operations out of the query expression. + + maxDegreeOfParallelism must be positive, was {0} + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/FSharp.Core.fsproj b/src/fsharp/FSharp.Core/FSharp.Core.fsproj index 588f72eaed..ef68a28e6d 100644 --- a/src/fsharp/FSharp.Core/FSharp.Core.fsproj +++ b/src/fsharp/FSharp.Core/FSharp.Core.fsproj @@ -4,8 +4,8 @@ Library - net45;netstandard1.6 - netstandard1.6 + net45;netstandard2.0 + netstandard2.0 $(NoWarn);45;55;62;75;1204 true $(DefineConstants);FSHARP_CORE @@ -113,21 +113,12 @@ Collections/set.fs - - Reflection/reshapedreflection.fs - Reflection/reflect.fsi Reflection/reflect.fs - - Numerics/n.fsi - - - Numerics/n.fs - Numerics/z.fsi @@ -223,11 +214,6 @@ - - - - - diff --git a/src/fsharp/FSharp.Core/Linq.fs b/src/fsharp/FSharp.Core/Linq.fs index e4deedbf07..fb9432075c 100644 --- a/src/fsharp/FSharp.Core/Linq.fs +++ b/src/fsharp/FSharp.Core/Linq.fs @@ -162,11 +162,6 @@ open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns open Microsoft.FSharp.Quotations.DerivedPatterns -#if FX_RESHAPED_REFLECTION -open PrimReflectionAdapters -open ReflectionAdapters -#endif - module LeafExpressionConverter = // The following is recognized as a LINQ 'member initialization pattern' in a quotation. @@ -219,11 +214,7 @@ module LeafExpressionConverter = SubstHelperRaw(q, x, y) |> Expr.Cast let showAll = -#if FX_RESHAPED_REFLECTION - true -#else BindingFlags.Public ||| BindingFlags.NonPublic -#endif let NullableConstructor = typedefof>.GetConstructors().[0] diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 742f04b32d..92ee245184 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -302,11 +302,6 @@ open Microsoft.FSharp.Quotations.DerivedPatterns open Microsoft.FSharp.Linq.QueryRunExtensions -#if FX_RESHAPED_REFLECTION -open PrimReflectionAdapters -open ReflectionAdapters -#endif - [] module Query = @@ -1804,7 +1799,6 @@ module Query = let linqQuery = TransInnerWithFinalConsume canElim queryProducingSequence let linqQueryAfterEliminatingNestedQueries = EliminateNestedQueries linqQuery -#if !FX_NO_SYSTEM_CONSOLE #if DEBUG let debug() = Printf.printfn "----------------------queryProducingSequence-------------------------" @@ -1814,20 +1808,17 @@ module Query = Printf.printfn "--------------------------linqQuery (after nested)-------------------" Printf.printfn "%A" linqQueryAfterEliminatingNestedQueries #endif -#endif let result = try LeafExpressionConverter.EvaluateQuotation linqQueryAfterEliminatingNestedQueries with e -> -#if !FX_NO_SYSTEM_CONSOLE #if DEBUG debug() Printf.printfn "--------------------------error--------------------------------------" Printf.printfn "%A" (e.ToString()) Printf.printfn "---------------------------------------------------------------------" -#endif #endif reraise () diff --git a/src/fsharp/FSharp.Core/QueryExtensions.fs b/src/fsharp/FSharp.Core/QueryExtensions.fs index 4885899fe8..bfddf7e57e 100644 --- a/src/fsharp/FSharp.Core/QueryExtensions.fs +++ b/src/fsharp/FSharp.Core/QueryExtensions.fs @@ -15,11 +15,6 @@ open System.Collections.Generic open System.Linq open System.Linq.Expressions -#if FX_RESHAPED_REFLECTION -open PrimReflectionAdapters -open ReflectionAdapters -#endif - // ---------------------------------------------------------------------------- /// A type used to reconstruct a grouping after applying a mutable->immutable mapping transformation @@ -171,11 +166,7 @@ module internal Adapters = let (|RecordFieldGetSimplification|_|) (expr:Expr) = match expr with | Patterns.PropertyGet(Some (Patterns.NewRecord(typ,els)),propInfo,[]) -> -#if FX_RESHAPED_REFLECTION - let fields = Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(typ, true) -#else let fields = Microsoft.FSharp.Reflection.FSharpType.GetRecordFields(typ,System.Reflection.BindingFlags.Public|||System.Reflection.BindingFlags.NonPublic) -#endif match fields |> Array.tryFindIndex (fun p -> p = propInfo) with | None -> None | Some i -> if i < els.Length then Some els.[i] else None diff --git a/src/fsharp/FSharp.Core/array.fs b/src/fsharp/FSharp.Core/array.fs index 8d7ce38869..0ac47bd39a 100644 --- a/src/fsharp/FSharp.Core/array.fs +++ b/src/fsharp/FSharp.Core/array.fs @@ -10,9 +10,6 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.CompilerServices open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators -#if FX_RESHAPED_REFLECTION - open System.Reflection -#endif /// Basic operations on arrays [] @@ -191,11 +188,7 @@ namespace Microsoft.FSharp.Collections [] let countBy (projection: 'T->'Key) (array: 'T[]) = checkNonNull "array" array -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then countByValueType projection array else countByRefType projection array @@ -445,11 +438,7 @@ namespace Microsoft.FSharp.Collections [] let groupBy (projection: 'T->'Key) (array: 'T[]) = checkNonNull "array" array -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then groupByValueType projection array else groupByRefType projection array diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 1f20f7c811..1d4eb37ecc 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -17,10 +17,6 @@ namespace Microsoft.FSharp.Control open Microsoft.FSharp.Control open Microsoft.FSharp.Collections -#if FX_RESHAPED_REFLECTION - open ReflectionAdapters -#endif - type LinkedSubSource(cancellationToken: CancellationToken) = let failureCTS = new CancellationTokenSource() @@ -168,13 +164,11 @@ namespace Microsoft.FSharp.Control let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) -#if !FX_NO_PARAMETERIZED_THREAD_START // Preallocate this delegate and keep it in the trampoline holder. let threadStartCallbackForStartThreadWithTrampoline = ParameterizedThreadStart (fun o -> let f = unbox<(unit -> AsyncReturn)> o this.ExecuteWithTrampoline f |> unfake) -#endif /// Execute an async computation after installing a trampoline on its synchronous stack. [] @@ -196,22 +190,10 @@ namespace Microsoft.FSharp.Control | null -> this.QueueWorkItemWithTrampoline f | _ -> this.PostWithTrampoline syncCtxt f -#if FX_NO_PARAMETERIZED_THREAD_START - // This should be the only call to Thread.Start in this library. We must always install a trampoline. - member this.StartThreadWithTrampoline (f: unit -> AsyncReturn) = -#if FX_NO_THREAD - this.QueueWorkItemWithTrampoline f -#else - (new Thread((fun _ -> this.Execute f |> unfake), IsBackground=true)).Start() - fake() -#endif - -#else // This should be the only call to Thread.Start in this library. We must always install a trampoline. member __.StartThreadWithTrampoline (f: unit -> AsyncReturn) = (new Thread(threadStartCallbackForStartThreadWithTrampoline, IsBackground=true)).Start(f|>box) fake() -#endif /// Save the exception continuation during propagation of an exception, or prior to raising an exception member inline __.OnExceptionRaised econt = @@ -731,12 +713,7 @@ namespace Microsoft.FSharp.Control match resEvent with | null -> () | ev -> -#if FX_NO_EVENTWAITHANDLE_IDISPOSABLE - ev.Dispose() - System.GC.SuppressFinalize ev -#else ev.Close() -#endif resEvent <- null) interface IDisposable with @@ -824,15 +801,7 @@ namespace Microsoft.FSharp.Control | None -> // OK, let's really wait for the Set signal. This may block. let timeout = defaultArg timeout Threading.Timeout.Infinite -#if FX_NO_EXIT_CONTEXT_FLAGS -#if FX_NO_WAITONE_MILLISECONDS - let ok = resHandle.WaitOne(TimeSpan(int64 timeout*10000L)) -#else - let ok = resHandle.WaitOne(millisecondsTimeout= timeout) -#endif -#else let ok = resHandle.WaitOne(millisecondsTimeout= timeout, exitContext=true) -#endif if ok then // Now the result really must be available result @@ -1196,7 +1165,13 @@ namespace Microsoft.FSharp.Control async { let! cancellationToken = cancellationTokenAsync return AsyncPrimitives.StartAsTask cancellationToken computation taskCreationOptions } - static member Parallel (computations: seq>) = + static member Parallel (computations: seq>) = Async.Parallel(computations, ?maxDegreeOfParallelism=None) + + static member Parallel (computations: seq>, ?maxDegreeOfParallelism: int) = + match maxDegreeOfParallelism with + | Some x when x < 1 -> raise(System.ArgumentException(String.Format(SR.GetString(SR.maxDegreeOfParallelismNotPositive), x), "maxDegreeOfParallelism")) + | _ -> () + MakeAsync (fun ctxt -> let tasks, result = try @@ -1251,19 +1226,61 @@ namespace Microsoft.FSharp.Control | _ -> () finishTask(Interlocked.Decrement &count) - tasks |> Array.iteri (fun i p -> - QueueAsync + // If maxDegreeOfParallelism is set but is higher then the number of tasks we have we set it back to None to fall into the simple + // queue all items branch + let maxDegreeOfParallelism = + match maxDegreeOfParallelism with + | None -> None + | Some maxDegreeOfParallelism -> if maxDegreeOfParallelism >= tasks.Length then None else Some maxDegreeOfParallelism + + // Simple case (no maxDegreeOfParallelism) just queue all the work, if we have maxDegreeOfParallelism set we start that many workers + // which will make progress on the actual computations + match maxDegreeOfParallelism with + | None -> + tasks |> Array.iteri (fun i p -> + QueueAsync + innerCTS.Token + // on success, record the result + (fun res -> recordSuccess i res) + // on exception... + (fun edi -> recordFailure (Choice1Of2 edi)) + // on cancellation... + (fun cexn -> recordFailure (Choice2Of2 cexn)) + p + |> unfake) + | Some maxDegreeOfParallelism -> + let mutable i = -1 + let worker = MakeAsync (fun _ -> + while i < tasks.Length do + let j = Interlocked.Increment &i + if j < tasks.Length then + let trampolineHolder = new TrampolineHolder() + trampolineHolder.ExecuteWithTrampoline (fun () -> + let ctxt = + AsyncActivation.Create + innerCTS.Token + trampolineHolder + (fun res -> recordSuccess j res) + (fun edi -> recordFailure (Choice1Of2 edi)) + (fun cexn -> recordFailure (Choice2Of2 cexn)) + tasks.[j].Invoke ctxt + ) + |> unfake + fake() + ) + for x = 1 to maxDegreeOfParallelism do + QueueAsync innerCTS.Token - // on success, record the result - (fun res -> recordSuccess i res) - // on exception... + (fun _ -> fake()) (fun edi -> recordFailure (Choice1Of2 edi)) - // on cancellation... (fun cexn -> recordFailure (Choice2Of2 cexn)) - p - |> unfake) + worker + |> unfake + fake())) + static member Sequential (computations: seq>) = Async.Parallel(computations, maxDegreeOfParallelism=1) + static member Choice(computations: Async<'T option> seq) : Async<'T option> = MakeAsync (fun ctxt -> let result = @@ -1385,15 +1402,7 @@ namespace Microsoft.FSharp.Control let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite if millisecondsTimeout = 0 then async.Delay(fun () -> -#if FX_NO_EXIT_CONTEXT_FLAGS -#if FX_NO_WAITONE_MILLISECONDS - let ok = waitHandle.WaitOne(TimeSpan 0L) -#else - let ok = waitHandle.WaitOne 0 -#endif -#else let ok = waitHandle.WaitOne(0, exitContext=false) -#endif async.Return ok) else CreateDelimitedUserCodeAsync(fun ctxt -> @@ -1683,12 +1692,7 @@ namespace Microsoft.FSharp.Control member stream.AsyncRead(buffer: byte[], ?offset, ?count) = let offset = defaultArg offset 0 let count = defaultArg count buffer.Length -#if FX_NO_BEGINEND_READWRITE - // use combo CreateDelimitedUserCodeAsync + taskContinueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task - CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWith (stream.ReadAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) -#else Async.FromBeginEnd (buffer, offset, count, stream.BeginRead, stream.EndRead) -#endif [] // give the extension member a 'nice', unmangled compiled name, unique within this module member stream.AsyncRead count = @@ -1705,12 +1709,7 @@ namespace Microsoft.FSharp.Control member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) = let offset = defaultArg offset 0 let count = defaultArg count buffer.Length -#if FX_NO_BEGINEND_READWRITE - // use combo CreateDelimitedUserCodeAsync + taskContinueWithUnit instead of AwaitTask so we can pass cancellation token to the WriteAsync task - CreateDelimitedUserCodeAsync (fun ctxt -> taskContinueWithUnit (stream.WriteAsync(buffer, offset, count, ctxt.aux.token)) ctxt false) -#else Async.FromBeginEnd (buffer, offset, count, stream.BeginWrite, stream.EndWrite) -#endif type IObservable<'Args> with @@ -1746,8 +1745,6 @@ namespace Microsoft.FSharp.Control | _ -> None) -#if !FX_NO_WEB_CLIENT - type System.Net.WebClient with member inline private this.Download(event: IEvent<'T, _>, handler: _ -> 'T, start, result) = let downloadAsync = @@ -1799,5 +1796,3 @@ namespace Microsoft.FSharp.Control start = (fun userToken -> this.DownloadFileAsync(address, fileName, userToken)), result = (fun _ -> ()) ) -#endif - diff --git a/src/fsharp/FSharp.Core/async.fsi b/src/fsharp/FSharp.Core/async.fsi index b3312c6990..fe4da64deb 100644 --- a/src/fsharp/FSharp.Core/async.fsi +++ b/src/fsharp/FSharp.Core/async.fsi @@ -161,6 +161,35 @@ namespace Microsoft.FSharp.Control /// A computation that returns an array of values from the sequence of input computations. static member Parallel : computations:seq> -> Async<'T[]> + /// Creates an asynchronous computation that executes all the given asynchronous computations, + /// initially queueing each as work items and using a fork/join pattern. + /// + /// If all child computations succeed, an array of results is passed to the success continuation. + /// + /// If any child computation raises an exception, then the overall computation will trigger an + /// exception, and cancel the others. + /// + /// The overall computation will respond to cancellation while executing the child computations. + /// If cancelled, the computation will cancel any remaining child computations but will still wait + /// for the other child computations to complete. + /// A sequence of distinct computations to be parallelized. + /// A computation that returns an array of values from the sequence of input computations. + static member Parallel : computations:seq> * ?maxDegreeOfParallelism : int -> Async<'T[]> + + /// Creates an asynchronous computation that executes all the given asynchronous computations sequentially. + /// + /// If all child computations succeed, an array of results is passed to the success continuation. + /// + /// If any child computation raises an exception, then the overall computation will trigger an + /// exception, and cancel the others. + /// + /// The overall computation will respond to cancellation while executing the child computations. + /// If cancelled, the computation will cancel any remaining child computations but will still wait + /// for the other child computations to complete. + /// A sequence of distinct computations to be run in sequence. + /// A computation that returns an array of values from the sequence of input computations. + static member Sequential : computations:seq> -> Async<'T[]> + /// Creates an asynchronous computation that executes all given asynchronous computations in parallel, /// returning the result of the first succeeding computation (one whose result is 'Some x'). /// If all child computations complete with None, the parent computation also returns None. @@ -415,8 +444,8 @@ namespace Microsoft.FSharp.Control static member StartImmediate: computation:Async * ?cancellationToken:CancellationToken-> unit - /// Runs an asynchronous computation, starting immediately on the current operating system, - /// but also returns the execution as System.Threading.Tasks.Task + /// Runs an asynchronous computation, starting immediately on the current operating system + /// thread, but also returns the execution as System.Threading.Tasks.Task /// /// If no cancellation token is provided then the default cancellation token is used. /// You may prefer using this method if you want to achive a similar behviour to async await in C# as @@ -739,8 +768,7 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that waits for response to the WebRequest. [] // give the extension member a nice, unmangled compiled name, unique within this module member AsyncGetResponse : unit -> Async - -#if !FX_NO_WEB_CLIENT + type System.Net.WebClient with /// Returns an asynchronous computation that, when run, will wait for the download of the given URI. @@ -761,7 +789,6 @@ namespace Microsoft.FSharp.Control /// An asynchronous computation that will wait for the download of the URI to specified file. [] // give the extension member a nice, unmangled compiled name, unique within this module member AsyncDownloadFile : address:System.Uri * fileName: string -> Async -#endif // Internals used by MailboxProcessor module internal AsyncBuilderImpl = diff --git a/src/fsharp/FSharp.Core/event.fs b/src/fsharp/FSharp.Core/event.fs index 4489c325d5..8643b669c3 100644 --- a/src/fsharp/FSharp.Core/event.fs +++ b/src/fsharp/FSharp.Core/event.fs @@ -11,10 +11,6 @@ namespace Microsoft.FSharp.Control open System.Reflection open System.Diagnostics -#if FX_RESHAPED_REFLECTION - open ReflectionAdapters -#endif - [] type DelegateEvent<'Delegate when 'Delegate :> System.Delegate>() = let mutable multicast : System.Delegate = null diff --git a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs index dd8d087345..b3fa821511 100644 --- a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs @@ -166,21 +166,13 @@ module ExtraTopLevelOperators = [] let dict (keyValuePairs:seq<'Key*'T>) : IDictionary<'Key,'T> = -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then dictValueType keyValuePairs :> _ else dictRefType keyValuePairs :> _ [] let readOnlyDict (keyValuePairs:seq<'Key*'T>) : IReadOnlyDictionary<'Key,'T> = -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then dictValueType keyValuePairs :> _ else dictRefType keyValuePairs :> _ @@ -227,7 +219,6 @@ module ExtraTopLevelOperators = [] let fprintfn (textWriter:TextWriter) format = Printf.fprintfn textWriter format -#if !FX_NO_SYSTEM_CONSOLE [] let printf format = Printf.printf format @@ -239,7 +230,6 @@ module ExtraTopLevelOperators = [] let eprintfn format = Printf.eprintfn format -#endif [] let failwith s = raise (Failure s) diff --git a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fsi b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fsi index 6cfbd860c4..6b43ddef90 100644 --- a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fsi +++ b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fsi @@ -11,9 +11,7 @@ module ExtraTopLevelOperators = open Microsoft.FSharp.Control open Microsoft.FSharp.Collections open Microsoft.FSharp.Text - open Microsoft.FSharp.Math -#if !FX_NO_SYSTEM_CONSOLE /// Print to stdout using the given format. /// The formatter. /// The formatted result. @@ -37,7 +35,6 @@ module ExtraTopLevelOperators = /// The formatted result. [] val eprintfn : format:Printf.TextWriterFormat<'T> -> 'T -#endif /// Print to a string using the given format. /// The formatter. diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index 653c557a45..e7fd17ee52 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -9,9 +9,6 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Collections open Microsoft.FSharp.Core.CompilerServices open System.Collections.Generic -#if FX_RESHAPED_REFLECTION - open System.Reflection -#endif [] [] @@ -71,11 +68,7 @@ namespace Microsoft.FSharp.Collections [] let countBy (projection:'T->'Key) (list:'T list) = -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then countByValueType projection list else countByRefType projection list @@ -446,11 +439,7 @@ namespace Microsoft.FSharp.Collections [] let groupBy (projection:'T->'Key) (list:'T list) = -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then groupByValueType projection list else groupByRefType projection list diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index d701fb87cf..d0fccda1fd 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -446,21 +446,19 @@ module MapTree = [] type Map<[]'Key, []'Value when 'Key : comparison >(comparer: IComparer<'Key>, tree: MapTree<'Key, 'Value>) = -#if !FX_NO_BINARY_SERIALIZATION [] - // This type is logically immutable. This field is only mutated during deserialization. - let mutable comparer = comparer + // This type is logically immutable. This field is only mutated during deserialization. + let mutable comparer = comparer [] - // This type is logically immutable. This field is only mutated during deserialization. - let mutable tree = tree + // This type is logically immutable. This field is only mutated during deserialization. + let mutable tree = tree - // This type is logically immutable. This field is only mutated during serialization and deserialization. + // This type is logically immutable. This field is only mutated during serialization and deserialization. // - // WARNING: The compiled name of this field may never be changed because it is part of the logical + // WARNING: The compiled name of this field may never be changed because it is part of the logical // WARNING: permanent serialization format for this type. - let mutable serializedData = null -#endif + let mutable serializedData = null // We use .NET generics per-instantiation static fields to avoid allocating a new object for each empty // set (it is just a lookup into a .NET table of type-instantiation-indexed static fields). @@ -468,7 +466,6 @@ type Map<[]'Key, [ new Map<'Key, 'Value>(comparer, MapTree<_, _>.MapEmpty) -#if !FX_NO_BINARY_SERIALIZATION [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = ignore context @@ -483,9 +480,8 @@ type Map<[]'Key, [ - tree <- serializedData |> Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer + tree <- serializedData |> Array.map (fun (KeyValue(k, v)) -> (k, v)) |> MapTree.ofArray comparer serializedData <- null -#endif static member Empty : Map<'Key, 'Value> = empty diff --git a/src/fsharp/FSharp.Core/math/n.fs b/src/fsharp/FSharp.Core/math/n.fs deleted file mode 100644 index f448940a8b..0000000000 --- a/src/fsharp/FSharp.Core/math/n.fs +++ /dev/null @@ -1,1599 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Math - -#if FX_NO_BIGINT -open System -open System.Diagnostics.CodeAnalysis -open Microsoft.FSharp.Core -open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators -open Microsoft.FSharp.Core.Operators -open Microsoft.FSharp.Collections -open Microsoft.FSharp.Primitives.Basics - -type ints = int array - -[] -type internal BigNat = - - // Have n = sum (from i=0 to bound) a.[i] * baseN ^ i - // Have 0 <= a.[i] < baseN. - //------ - // Invariant: bound is least such, i.e. bound=0 or (a.[bound-1] is highest coeff). - // Zero is {bound=0,a=...}. - // Naturals are a normal form, - // but not structurally so, - // since arrays may have non-contributing cells at a.[bound] and beyond. - // - { mutable bound : int; // non-zero coeff must be 0...(bound-1) - digits : ints // must have at least elts 0...(bound-1), - // maybe more (which should be zero!). - // Actually, the "zero" condition may be relaxed. - // - } - - -module internal BigNatModule = - - //------------------------------------------------------------------------- - // misc - //----------------------------------------------------------------------- - - #if SELFTEST - let check b = if not b then failwith "assertion failwith" - #endif - - module FFT = - let rec pow32 x n = - if n=0 then 1 - elif n % 2 = 0 then pow32 (x*x) (n / 2) - else x* pow32 (x*x) (n / 2) - - let leastBounding2Power b = - let rec findBounding2Power b tp i = if b<=tp then tp,i else findBounding2Power b (tp*2) (i+1) in - findBounding2Power b 1 0 - - //------------------------------------------------------------------------- - // p = 2^k.m + 1 prime and w primitive 2^k root of 1 mod p - //----------------------------------------------------------------------- - - // Given p = 2^k.m + 1 prime and w a primitive 2^k root of unity (mod p). - // Required to define arithmetic ops for Fp = field modulo p. - // The following are possible choices for p. - - // p, k, m, g, w - // let p,k,m,g,w = 97L, 4, 6, 5, 8 // p is 7 bit - // let p,k,m,g,w = 769L, 8, 3, 7, 7 // p is 10 bit - // let p,k,m,g,w = 7681L, 8, 30, 13, 198 // p is 13 bit - // let p,k,m,g,w = 12289L, 10, 12, 11, 49 // p is 14 bit - // let p,k,m,g,w = 167772161L, 25, 5, 557092, 39162105 // p is 28 bit - // let p,k,m,g,w = 469762049L, 26, 7, 1226571, 288772249 // p is 29 bit - - - let p,k,m,g,w = 2013265921L, 27, 15, 31, 440564289 // p is 31 bit - let primeP = p - - let maxBitsInsideFp = 30 - - - //------------------------------------------------------------------------- - // Fp = finite field mod p - rep is uint32 - //----------------------------------------------------------------------- - - - type fp = uint32 - // operations in Fp (finite field size p) - module Fp = - //module I = UInt32 - let p = 2013265921ul : fp - let p64 = 2013265921UL : uint64 - let toInt (x:fp) : int = int32 x - let ofInt32 (x:int) : fp = uint32 x - - let mzero : fp = 0ul - let mone : fp = 1ul - let mtwo : fp = 2ul - let inline madd (x:fp) (y:fp) : fp = (x + y) % p - let inline msub (x:fp) (y:fp) : fp = (x + p - y) % p - let inline mmul (x:fp) (y:fp) : fp = uint32 ((uint64 x * uint64 y) % p64) - - let rec mpow x n = - if n=0 then mone - elif n % 2=0 then mpow (mmul x x) (n / 2) - else mmul x (mpow (mmul x x) (n / 2)) - - let rec mpowL x n = - if n = 0L then mone - elif n % 2L = 0L then mpowL (mmul x x) (n / 2L) - else mmul x (mpowL (mmul x x) (n / 2L)) - - // Have the w is primitive 2^kth root of 1 in Zp - let m2PowNthRoot n = - // Find x s.t. x is (2^n)th root of unity. - // - // pow w (pow 2 k) = 1 primitively. - // = pow w (pow 2 ((k-n)+n)) - // = pow w (pow 2 (k-n) * pow 2 n) - // = pow (pow w (pow 2 (k-n))) (pow 2 n) - // - // Take wn = pow (pow w (pow 2 (k-n))) - - mpow (uint32 w) (pow32 2 (k-n)) - - let minv x = mpowL x (primeP - 2L) - - - //------------------------------------------------------------------------- - // FFT - in place low garbage - //----------------------------------------------------------------------- - - open Fp - let rec computeFFT lambda mu n w (u: _[]) (res: _[]) offset = - // Given n a 2-power, - // w an nth root of 1 in Fp, and - // lambda, mu and u(x) defining - // poly(lambda,mu,x) = sum(i pow32 2 i) - - let computeFftPaddedPolynomialProduct bigK k u v = - // REQUIRES: bigK = 2^k - // REQUIRES: Array lengths of u and v = bigK. - // REQUIRES: degree(uv) <= bigK-1 - // --- - // Given u,v polynomials. - // Computes the product polynomial by FFT. - // For correctness, - // require the result coeff to be in range [0,p-1], for p defining Fp above. - - #if SELFTEST - check ( k <= maxTwoPower ); - check ( bigK = twoPowerTable.[k] ); - check ( u.Length = bigK ); - check ( v.Length = bigK ); - #endif - // Find 2^k primitive root of 1 - let w = m2PowNthRoot k - // FFT - let n = bigK - let uT = computFftInPlace n w u - let vT = computFftInPlace n w v - // Evaluate - let rT = Array.init n (fun i -> mmul uT.[i] vT.[i]) - // INV FFT - let r = computeInverseFftInPlace n w rT - r - - let padTo n (u: _ array) = - let uBound = u.Length - Array.init n (fun i -> if i mmul uT.[i] vT.[i]) - // INV FFT - let r = computeInverseFftInPlace n w rT - Array.map Fp.toInt r - - - //------------------------------------------------------------------------- - // fp exports - //----------------------------------------------------------------------- - - open Fp - let mzero = mzero - let mone = mone - let maxFp = msub Fp.p mone - - //------------------------------------------------------------------------- - // FFT - reference implementation - //----------------------------------------------------------------------- - - #if SELFTEST - open Fp - let rec computeFftReference n w u = - // Given n a 2-power, - // w an nth root of 1 in Fp, and - // u(x) = sum(i u.[2*i]) - let uodd = Array.init (n/2) (fun i -> u.[2*i+1]) - let uevenFT = computeFftReference (n/2) (mmul w w) ueven - let uoddFT = computeFftReference (n/2) (mmul w w) uodd - Array.init n - (fun j -> - if j < n/2 then - madd - (uevenFT.[j]) - (mmul - (mpow w j) - (uoddFT.[j])) - else - let j = j - (n/2) - msub - (uevenFT.[j]) - (mmul - (mpow w j) - (uoddFT.[j]))) - #endif - - open FFT - - type n = BigNat - - let bound (n: n) = n.bound - let setBound (n: n) (v:int32) = n.bound <- v - let coeff (n:n) i = n.digits.[i] - let coeff64 (n:n) i = int64 (coeff n i) - let setCoeff (n:n) i v = n.digits.[i] <- v - - let rec pow64 x n = - if n=0 then 1L - elif n % 2 = 0 then pow64 (x * x) (n / 2) - else x * (pow64 (x * x) (n / 2)) - - let rec pow32 x n = - if n=0 then 1 - elif n % 2 = 0 then pow32 (x*x) (n / 2) - else x* pow32 (x*x) (n / 2) - - let hash(n) = - let mutable res = 0 - for i = 0 to n.bound - 1 do // could stop soon, it's "hash" - res <- n.digits.[i] + (res <<< 3) - done; - res - - //---------------------------------------------------------------------------- - // misc - //-------------------------------------------------------------------------- - -#if CHECKED - let check b str = if not b then failwith ("check failed: " + str) -#endif - let maxInt a b = if a int32 - let inline div64base (x:int64) = int64 (uint64 x >>> baseBits) - - let divbase x = int32 (uint32 x >>> baseBits) - let modbase x = (x &&& baseMask) - - let inline index z i = if i < z.bound then z.digits.[i] else 0 - - let createN b = { bound = b; - digits = Array.zeroCreate b } - let copyN x = { bound = x.bound; - digits = Array.copy x.digits } // could copy just enough... - - let normN n = - // normalises bound - let rec findLeastBound (na:ints) i = if i = -1 || na.[i]<>0 then i+1 else findLeastBound na (i-1) - let bound = findLeastBound n.digits (n.bound-1) - n.bound <- bound; - n - - let boundInt = 2 // int will fit with bound=2 - let boundInt64 = 3 // int64 will fit with bound=3 - let boundBase = 1 // base will fit with bound=1 - obviously! - -//---------------------------------------------------------------------------- -// base, coefficients, poly -//-------------------------------------------------------------------------- - - let embed x = - let x = if x<0 then 0 else x // no -ve naturals - if x < baseN then - let r = createN 1 - r.digits.[0] <- x; - normN r - else - let r = createN boundInt - for i = 0 to boundInt - 1 do - r.digits.[i] <- (x / pow32 baseN i) % baseN - done; - normN r - - let embed64 x = - let x = if x<0L then 0L else x // no -ve naturals - let r = createN boundInt64 - for i = 0 to boundInt64-1 do - r.digits.[i] <- int32 ( (x / pow64 baseNi64 i) % baseNi64) - done; - normN r - - let eval n = - if n.bound = 1 - then n.digits.[0] - else - let mutable acc = 0 - for i = n.bound-1 downto 0 do - acc <- n.digits.[i] + baseN * acc - done; - acc - - let eval64 n = - if n.bound = 1 - then int64 n.digits.[0] - else - let mutable acc = 0L - for i = n.bound-1 downto 0 do - acc <- int64 (n.digits.[i]) + baseNi64 * acc - done; - acc - - let one = embed 1 - let zero = embed 0 - - let restrictTo d n = - { bound = minInt d n.bound; digits = n.digits} - - let shiftUp d n = - let m = createN (n.bound+d) - for i = 0 to n.bound-1 do - m.digits.[i+d] <- n.digits.[i] - done; - m - - let shiftDown d n = - if n.bound-d<=0 then - zero - else - let m = createN (n.bound-d) - for i = 0 to m.bound-1 do - m.digits.[i] <- n.digits.[i+d] - done; - m - - let degree n = n.bound-1 - - -//---------------------------------------------------------------------------- -// add, sub -//-------------------------------------------------------------------------- - - // addition - let rec addP i n c p q r = // p+q + c - if i0 then - r.digits.[i] <- modbase x; - let c = divbase x - // if p (or q) exhausted and c zero could switch to copying mode - subP (i+1) n c p q r - else - let x = x + baseN // add baseN - r.digits.[i] <- modbase x; - let c = divbase x - 1 // sub baseN - // if p (or q) exhausted and c zero could switch to copying mode - subP (i+1) n c p q r - else - let underflow = c<>0 - underflow - - let sub p q = - // NOTE: x-y=0 when x<=y, it is natural subtraction - let rbound = maxInt p.bound q.bound - let r = createN rbound - let carry = 0 - let underflow = subP 0 rbound carry p q r - if underflow then - embed 0 - else - normN r - - -//---------------------------------------------------------------------------- -// isZero, equal, ordering, sign, min, max -//-------------------------------------------------------------------------- - - let isZero p = p.bound=0 - let IsZero p = isZero p - let isOne p = p.bound=1 && p.digits.[0] = 1 - - let equal p q = - (p.bound = q.bound) && - (let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j] = qa.[j] for i < j < p.bound - (i = -1) || (pa.[i]=qa.[i] && check pa qa (i-1)) - - check p.digits q.digits (p.bound-1)) - - let shiftCompare p pn q qn = - if p.bound + pn < q.bound + qn then -1 - elif p.bound + pn > q.bound + pn then 1 - else - let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j-pn] = qa.[j-qn] for i < j < p.bound - // Looking for most significant differing coeffs to determine ordering - if i = -1 then - 0 - else - let pai = if i < pn then 0 else pa.[i-pn] - let qai = if i < qn then 0 else qa.[i-qn] - if pai = qai then check pa qa (i-1) - elif pai < qai then -1 - else 1 - - check p.digits q.digits (p.bound + pn - 1) - - let compare p q = - if p.bound < q.bound then -1 - elif p.bound > q.bound then 1 - else - let rec check (pa:ints) (qa:ints) i = - // HAVE: pa.[j] = qa.[j] for i < j < p.bound - // Looking for most significant differing coeffs to determine ordering - if i = -1 then 0 - elif pa.[i]=qa.[i] then check pa qa (i-1) - elif pa.[i]] - let lt p q = compare p q = -1 - [] - let gt p q = compare p q = 1 - [] - let lte p q = compare p q <> 1 - [] - let gte p q = compare p q <> -1 - - [] - let min a b = if lt a b then a else b - [] - let max a b = if lt a b then b else a - - -//---------------------------------------------------------------------------- -// scale -//-------------------------------------------------------------------------- - - // REQUIRE: baseN + baseN.2^32 < Int64.maxInt - let rec contributeArr (a:ints) i (c:int64) = - // Given c and require c < baseN.2^32 - // Compute: r <- r + c . B^i - // via r.digits.[i] <- r.digits.[i] + c and normalised - let x = int64 a.[i] + c - // HAVE: x < baseN + baseN.2^32 - let c = div64base x - let x = mod64base x - // HAVE: c < 1 + 2^32 < baseN.2^32, recursive call ok - // HAVE: x < baseN - a.[i] <- x; // store residue x - if c>0L then - contributeArr a (i+1) c // contribute carry next position - - let inline contribute r i c = contributeArr r.digits i c - - // REQUIRE: maxInt < 2^32 - [] - let rec scale (k:int) (p:n) = - // Given k and p and require k < 2^32 - // Computes "scalar" product k.p - // - let rbound = p.bound + boundInt - let r = createN rbound - let k = int64 k - for i = 0 to p.bound-1 do - let kpi = k * int64 p.digits.[i] - // HAVE: kpi < 2^32 * baseN which meets "contribute" requirement - contribute r i kpi - done; - normN r - - -//---------------------------------------------------------------------------- -// mulSchoolBook -//-------------------------------------------------------------------------- - - // multiplication: naively O(n^2) -(* - let mulSchoolBook' p q = - let rbound = p.bound + q.bound + boundBase*2 - let r = createN rbound - let pa = p.digits - let qa = q.digits - for i = 0 to p.bound-1 do - for j = 0 to q.bound-1 do - contribute r (i+j) (int64 pa.[i] * int64 qa.[j]) - done - done; - normN r -*) - - let mulSchoolBookBothSmall p q = - let r = createN 2 - let rak = int64 p * int64 q - setCoeff r 0 (mod64base rak); - setCoeff r 1 (int32 (div64base rak)) - normN r - - let rec mulSchoolBookCarry r c k = - if ( c > 0L ) then - // ToAdd = c.B^k - let rak = (coeff64 r k) + c - setCoeff r k (mod64base rak); - mulSchoolBookCarry r (div64base rak) (k + 1) - - let mulSchoolBookOneSmall p q = - let bp = bound(p) - let rbound = bp + 1 - let r = createN rbound - let q = int64 q - let mutable c = 0L - for i = 0 to bp-1 do - let rak = c + (coeff64 r i) + (coeff64 p i) * q - setCoeff r i (mod64base rak); - c <- div64base rak; - mulSchoolBookCarry r c bp - normN r - - - // multiplication: naively O(n^2) -- this version - unchecked - is faster - let mulSchoolBookNeitherSmall p q = - let rbound = p.bound + q.bound - let r = createN rbound - let ra = r.digits - let pa = p.digits - let qa = q.digits - // ToAdd p*q - for i = 0 to p.bound-1 do - // ToAdd p.[i] * q * B^i - let pai = int64 pa.[i] - let mutable c = 0L - let mutable k = i // k = i + j - // ToAdd = pi.qj.B^(i+j) for j = 0,j+1... - for j = 0 to q.bound-1 do - // ToAdd = c.B^k + pi.qj.B^(i+j) for j = j,j+1... and k = i+j - let qaj = int64 qa.[j] - let rak = int64 ra.[k] + c + pai * qaj - ra.[k] <- int32 (mod64base rak); - c <- div64base rak; - k <- k + 1; - mulSchoolBookCarry r c k - normN r - - let mulSchoolBook p q = - let pSmall = (bound(p) = 1) - let qSmall = (bound(q) = 1) - if (pSmall && qSmall) then mulSchoolBookBothSmall (coeff p 0) (coeff q 0) - elif pSmall then mulSchoolBookOneSmall q (coeff p 0) - elif qSmall then mulSchoolBookOneSmall p (coeff q 0) - else mulSchoolBookNeitherSmall p q - - -//---------------------------------------------------------------------------- -// quickMulUsingFft -//-------------------------------------------------------------------------- - - // The FFT polynomial multiplier requires the result coeffs fit inside Fp. - // - // OVERVIEW: - // The numbers are recoded as polynomials to be evaluated at (x=2^bigL). - // The polynomials are FFT multiplied, requiring result coeff to fit Fp. - // The result product is recovered by evaluating the poly at (x=2^bigL). - // - // REF: - // QuickMul: Practical FFT-base Integer Multiplication, - // Chee Yap and Chen Yi. - // - // There is choice of how to encode the nats polynomials. - // The choice is the (2^bigL) base to use. - // For bigL=1, the FFT will cater for a product of upto 256M bits. - // Larger bigL have less reach, but compute faster. - // So plan to choose bigL depending on the number of bits product. - // - // DETERMINING THE K,L BOUNDS. - // - // Given representing using K-vectors, K a power of 2, K=2^k, and - // If choosing inputs to have L-bit coefficients. - // - // The result coeff are: - // - // res(i) = sum (j] - type encoding = - { bigL : int; // bits per input coeff - twoToBigL : int; // 2^bigL - k : int; - bigK : int; // bigK = 2^k, number of terms polynomials - bigN : int; // bits result (under-estimate of limit) - split : int; // baseBits / bigL - splits : int array; - } - -#if CHECKED - let _ = check (baseBits=24) "24bit" -#endif - // Requiring baseN mod 2^bigL = 0 gave quick encoding, but... - // also a terrible drop performance when the bigK jumped by more than needed! - // Below, it choose a minimal bigK to hold the product. - - let mkEncoding (bigL,k,bigK,bigN) = -#if CHECKED - check (bigK = pow32 2 k) "bigK"; - check (bigN = bigK * bigL) "bigN"; - check (2 * bigL + k <= maxBitsInsideFp) "constraint"; -#endif - { bigL = bigL; - twoToBigL = pow32 2 bigL; - k = k; - bigK = bigK; - bigN = bigN; - split = baseBits/bigL; // should divide exactly - splits = Array.init (baseBits/bigL) (fun i -> pow32 2 (bigL*i)) - } - - let table = - [| // bigL , k , bigK , bigN // - mkEncoding ( 1 , 28 , 268435456 , 268435456 ) ; - mkEncoding ( 2 , 26 , 67108864 , 134217728 ) ; - mkEncoding ( 3 , 24 , 16777216 , 50331648 ) ; - mkEncoding ( 4 , 22 , 4194304 , 16777216 ) ; - mkEncoding ( 5 , 20 , 1048576 , 5242880 ) ; - mkEncoding ( 6 , 18 , 262144 , 1572864 ) ; - mkEncoding ( 7 , 16 , 65536 , 458752 ) ; - mkEncoding ( 8 , 14 , 16384 , 131072 ) ; - mkEncoding ( 9 , 12 , 4096 , 36864 ) ; - mkEncoding ( 10 , 10 , 1024 , 10240 ) ; - mkEncoding ( 11 , 8 , 256 , 2816 ) ; - mkEncoding ( 12 , 6 , 64 , 768 ) ; - mkEncoding ( 13 , 4 , 16 , 208 ) ; - |] - - let calculateTableTow bigL = - // Given L. - // Have L via "log2 K <= maxBitsInsideFp - 2L". - // Have N via "N = K.L" - // - let k = maxBitsInsideFp - 2*bigL - let bigK = pow64 2L k - let N = bigK * int64 bigL - bigL,k,bigK,N - - let encodingGivenResultBits bitsRes = - // choose maximum bigL s.t. bitsRes < bigN - // EXCEPTION: fails is bitsRes exceeds 2^28 (largest bigN table) - let rec selectFrom i = - if i+1 < table.Length && bitsRes < table.[i+1].bigN then - selectFrom (i+1) - else - table.[i] - - if bitsRes >= table.[0].bigN then - failwith "Product is huge, around 268435456 bits, beyond quickmul" - else - selectFrom 0 - - let bitmask = Array.init baseBits (fun i -> (pow32 2 i - 1)) - let twopowers = Array.init baseBits (fun i -> (pow32 2 i)) - let twopowersI64 = Array.init baseBits (fun i -> (pow64 2L i)) - // bitmask(k) = 2^k - 1 - // twopowers(k) = 2^k // - - let wordBits word = - let rec hi k = - if k=0 then 0 - elif (word &&& twopowers.[k-1]) <> 0 then k - else hi (k-1) - - hi baseBits - - let bits u = - if u.bound=0 then 0 - else degree u * baseBits + wordBits u.digits.[degree u] - - let extractBits n enc bi = - let bj = bi + enc.bigL - 1 // the last bit (inclusive) - let biw = bi / baseBits // first bit is this index pos - let bjw = bj / baseBits // last bit is this index pos - if biw <> bjw then - // two words - let x = index n biw - let y = index n bjw // bjw = biw+1 - let xbit = bi % baseBits // start bit x - let nxbits = baseBits - xbit // number of bitsin x - let x = x >>> xbit // shift down x so bit0 is first - let y = y <<< nxbits // shift up y so it starts where x finished - let x = x ||| y // combine them - let x = x &&& bitmask.[enc.bigL] // mask out (high y bits) to get required bits - x - else - // one word - let x = index n biw - let xbit = bi % baseBits // start bit x - let x = x >>> xbit - let x = x &&& bitmask.[enc.bigL] - x - - let encodePoly enc n = - // Find poly s.t. n = poly evaluated at x=2^bigL - // with 0 <= pi < 2^bigL. - // - let poly = Array.create enc.bigK (Fp.ofInt32 0) - let biMax = n.bound * baseBits - let rec encoder i bi = - // bi = i * bigL - if i=enc.bigK || bi > biMax then - () // done - else - ( let pi = extractBits n enc bi - poly.[i] <- Fp.ofInt32 pi; - let i = i + 1 - let bi = bi + enc.bigL - encoder i bi - ) - - encoder 0 0; - poly - - let decodeResultBits enc (poly : fp array) = - // Decoding evaluates poly(x) (coeff Fp) at X = 2^bigL. - // A bound on number of result bits is "enc.bigN + boundInt", but that takes HUGE STEPS. - // Garbage has a cost, so we minimize it by working out a tight bound. - // - // poly(X) = sum i=0..n coeff_i * X^i where n is highest non-zero coeff. - // <= 2^maxBitsInsideFp * (1 + X + ... X^n) - // <= 2^maxBitsInsideFp * (X^(n+1) - 1) / (X - 1) - // <= 2^maxBitsInsideFp * X^(n+1) / (X - 1) - // <= 2^maxBitsInsideFp * X^(n+1) / (X/2) provided X/2 <= X-1 - // <= 2^maxBitsInsideFp * X^n * 2 - // <= 2^maxBitsInsideFp * (2^bigL)^n * 2 - // <= 2^(maxBitsInsideFp + bigL.n + 1) - // - let mutable n = 0 - for i = 0 to poly.Length-1 do - if poly.[i] <> mzero then n <- i - done; - let rbits = maxBitsInsideFp + enc.bigL * n + 1 - rbits + 1 // +1 since 2^1 requires 2 bits not 1 - - // REQUIRE: bigL <= baseBits - let decodePoly enc poly = - // Find n = poly evaluated at x=2^bigL - // Note, 0 <= pi < maxFp. - // - let rbound = (decodeResultBits enc poly) / baseBits + 1 - let r = createN rbound - let rec evaluate i j d = - // HAVE: bigL.i = j * baseBits + d and d= rbound then -#if CHECKED - check (poly.[i] = mzero) "decodePoly"; -#endif - () - else ( - let x = int64 (Fp.toInt poly.[i]) * twopowersI64.[d] - // HAVE: x < 2^32 . 2^baseBits = 2^32.baseN - contribute r j x - ); - let i = i + 1 - let d = d + enc.bigL - let j,d = if d >= baseBits then j+1 , d-baseBits else j,d - // HAVE: d < baseBits, note: bigL minDigitsKaratsuba then - let k = bmax / 2 - let a0 = restrictTo k p - let a1 = shiftDown k p - let b0 = restrictTo k q - let b1 = shiftDown k q - let q0 = mul a0 b0 - let q1 = mul (add a0 a1) (add b0 b1) - let q2 = mul a1 b1 - let p0 = q0 - let p1 = sub q1 (add q0 q2) - let p2 = q2 - let r = add p0 (shiftUp k (add p1 (shiftUp k p2))) - r - else - mulSchoolBook p q - - let rec mulKaratsuba x y = recMulKaratsuba mulKaratsuba x y - - -//---------------------------------------------------------------------------- -// mul - composite -//-------------------------------------------------------------------------- - - let productDigitsUpperSchoolBook = (64000 / baseBits) - // When is it worth switching away from SchoolBook? - // SchoolBook overhead is low, so although it's O(n^2) it remains competitive. - // - // 28/3/2006: - // The FFT can take over from SchoolBook at around 64000 bits. - // Note, FFT performance is stepwise, according to enc from table. - // The steps are big steps (meaning sudden jumps/drops perf). - // - - let singleDigitForceSchoolBook = (32000 / baseBits) - // If either argument is "small" then stay with SchoolBook. - // - - let productDigitsUpperFft = (table.[0].bigN / baseBits) - // QuickMul is good upto a finite (but huge) limit: - // Limit 268,435,456 bits product. - // - // From the code: - // let bitsRes = bits u + bits v - // fails when bitsRes >= table.[0].bigN - // So, not applicable when: - // P1: table.[0].bigN <= bits(u) + bits(v) - // P2: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) - // P3: table.[0].bigN <= .. <= baseBits * (u.bound + v.bound) - // P4: table.[0].bigN / baseBits <= u.bound + v.bound - // - - // Summary of mul algorithm choice: - // 0 <= uv_bound < upper_school_book - Schoolbook - // upper_school_book <= uv_bound < upper_fft - QuickMul - // upper_fft <= uv_bound < ... - Karatsuba - // - // NOTE: - // - Karatsuba current implementation has high garbage cost. - // - However, a linear space cost is possible... - // - Meantime, switch to Karatsuba only beyond FFT range. - // - - let rec mul p q = - let pqBound = p.bound + q.bound - if pqBound < productDigitsUpperSchoolBook || - p.bound < singleDigitForceSchoolBook || - q.bound < singleDigitForceSchoolBook - then - // Within school-book initial range: - mulSchoolBook p q - else - if pqBound < productDigitsUpperFft then - // Inside QuickMul FFT range: - quickMulUsingFft p q - else - // Beyond QuickMul FFT range, or maybe between Schoolbook and QuickMul (no!): - // Use karatsuba method, with "mul" as recursive multiplier, - // so will reduce sizes of products on recursive calls, - // and QuickMul will take over if they fall within it's range. - // - recMulKaratsuba mul p q - - -//---------------------------------------------------------------------------- -// division - scaleSubInPlace -//-------------------------------------------------------------------------- - - let scaleSubInPlace x f a n = - // Have x = sumR 0 xd (\i.xi.B^i) where xd = degree x - // a = sumR 0 ad (\i.digitsi.B^i) where ad = degree a - // f < B - // n < xd - // Assumes "f.digits.B^n < x". - // Required to remove f.digits.B^n from x place. - //------ - // Result = x_initial - f.digits.B^n - // = x_initial - f.[sumR 0 ad (\i.digitsi.B^(i+n))] - // State: j = 0 - // z = f * a0 - // Invariant(x,z,j,n): - // P1: x_result = x - z.B^(j+n) - f.[sumR (j+1) ad (\i.digitsi.B^i+n)] - // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. - // Base: Invariant holds initially. - // Step: (a) Remove zLo from x: - // If zLo <= x_(j+n) then zLo <- 0 - // x_(j+n) <- x_(j+n) - zLo - // else zLo <- 0 - // x_(j+n) <- x_(j+n) + (B - zLo) - // = x_(j+n) - zLo + B - // zHi <- zHi + 1 - // Here, invariant P1 still holds, P2 may break. - // (b) Advance j: - // Have z = zHi.B since zLo = 0. - // j <- j + 1 - // z <- zHi + f * a_(j+1) - // P2 holds: - // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 - // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. - // P1 holds, - // moved f.digits_(j+1).B^(j+1+n) factor over. - // - // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). - // Continue until z = 0, which happens since z decreases towards 0. - // Done. - // - let invariant (_,_,_) = () - #if CHECKED - let x_initial = copyN x - let x_result = sub x_initial (shiftUp n (scale f a)) - let invariant (z,j,n) = - let P1 = - equal - x_result - (sub x (add (shiftUp (j+n) (embed64 z)) - (mul (embed f) - (shiftUp (j+1+n) (shiftDown (j+1) a))))) - let P2 = z < baseNi64 * baseNi64 - 1L - check P1 "P1"; - check P2 "P2" - - #endif - let xres = x - let x,xd = x.digits,degree x - let a,ad = a.digits,degree a - let f = int64 f - let mutable j = 0 - let mutable z = f * int64 a.[0] - while( z > 0L || j < ad ) do - if j > xd then failwith "scaleSubInPlace: pre-condition did not apply, result would be -ve"; - invariant(z,j,n); // P1,P2 hold - let mutable zLo = mod64base z |> int32 - let mutable zHi = div64base z - if zLo <= x.[j+n] then - x.[j+n] <- x.[j+n] - zLo - else ( - x.[j+n] <- x.[j+n] + (baseN - zLo); - zHi <- zHi + 1L - ); - // P1 holds - if j < ad then - z <- zHi + f * int64 a.[j+1] - else - z <- zHi; - j <- j + 1; - // P1,P2 hold - done; - ignore (normN xres) - - // - let scaleSub x f a n = - let freshx = add x zero - scaleSubInPlace freshx f a n; - normN freshx -(* - - let scaleSub2 x f a n = sub x (shiftUp n (mul (embed f) a)) - - let x = (mul (embed 234234234) (pow (embed 10) (embed 20))) - let f = 2 - let a = (embed 1231231231) - let n = 2 - let res = scaleSub x f a n - let res2 = scaleSub2 x f a n - - let x, xd, f, a, ad, n = freshx.digits, freshx.bound, f, a.digits, a.bound, n - *) - - -//---------------------------------------------------------------------------- -// division - scaleAddInPlace -//-------------------------------------------------------------------------- - - let scaleAddInPlace x f a n = - // Have x = sumR 0 xd (\i.xi.B^i) - // a = sumR 0 ad (\i.digitsi.B^i) - // f < B - // n < xd - // Required to add f.digits.B^n to x place. - // Assumes result will fit with x (0...xd). - //------ - // Result = x_initial + f.digits.B^n - // = x_initial + f.[sumR 0 ad (\i.digitsi.B^i+n)] - // State: j = 0 - // z = f * a0 - // Invariant(x,z,j,n): - // P1: x_result = x + z.B^(j+n) + f.[sumR (j+1) ad (\i.digitsi.B^i+n)] - // P2: z < B^2 - 1, and so has form z = zHi.B + zLo for zHi,zLo < B. - // Base: Invariant holds initially. - // Step: (a) Add zLo to x: - // If zLo < B - x_(j+n) then zLo <- 0 - // x_(j+n) <- x_(j+n) + zLo - // else zLo <- 0 - // x_(j+n) <- zLo - (B - x_(j+n)) - // = x_(j+n) + zLo - B - // zHi <- zHi + 1 - // Here, invariant P1 still holds, P2 may break. - // (b) Advance j: - // Have z = zHi.B since zLo = 0. - // j <- j + 1 - // z <- zHi + f * a_(j+1) - // P2 holds: - // Have z <= B + (B-1)*(B-1) = B + B^2 - 2B + 1 = B^2 - B + 1 - // Have z <= B^2 - 1 when B >= 2 which is required for B being a base. - // P1 holds, - // moved f.digits_(j+1).B^(j+1+n) factor over. - // - // Once j+1 exceeds ad, summation is zero and it contributes no more terms (b). - // Continue until z = 0, which happens since z decreases towards 0. - // Done. - // - let invariant (_,_,_) = () -#if CHECKED - let x_initial = copyN x - let x_result = add x_initial (shiftUp n (scale f a)) - let invariant (z,j,n) = - let P1 = - equal - x_result - (add x (add (shiftUp (j+n) (embed64 z)) - (mul (embed f) - (shiftUp (j+1+n) (shiftDown (j+1) a))))) - let P2 = z < baseNi64 * baseNi64 - 1L - check P1 "P1"; - check P2 "P2" - -#endif - let xres = x - let x,xd = x.digits,degree x - let a,ad = a.digits,degree a - let f = int64 f - let mutable j = 0 - let mutable z = f * int64 a.[0] - while( z > 0L || j < ad ) do - if j > xd then failwith "scaleSubInPlace: pre-condition did not apply, result would be -ve"; - invariant(z,j,n); // P1,P2 hold - let mutable zLo = mod64base z |> int32 - let mutable zHi = div64base z - if zLo < baseN - x.[j+n] then - x.[j+n] <- x.[j+n] + zLo - else ( - x.[j+n] <- zLo - (baseN - x.[j+n]); - zHi <- zHi + 1L - ); - // P1 holds - if j < ad then - z <- zHi + f * int64 a.[j+1] - else - z <- zHi; - j <- j + 1; - // P1,P2 hold - done; - ignore (normN xres) - - // - let scaleAdd x f a n = - let freshx = add x zero - scaleAddInPlace freshx f a n; - normN freshx - -(* - let scaleAdd2 x f a n = add x (shiftUp n (mul (embed f) a)) - - let x = (mul (embed 234234234) (pow (embed 10) (embed 20))) - let f = 2 - let a = (embed 1231231231) - let n = 2 - let res = scaleAdd x f a n - let res2 = scaleAdd2 x f a n - - let x, xd, f, a, ad, n = freshx.digits, freshx.bound, f, a.digits, a.bound, n -*) - -//---------------------------------------------------------------------------- -// division - removeFactor -//-------------------------------------------------------------------------- - - (* - let removeFactorReference x a n = - let ff = div x (shiftUp n a) - toInt ff - *) - - let removeFactor x a n = - // Assumes x < a.B^(n+1) - // Choose f s.t. - // (a) f.digits.B^n <= x - // (b) f=0 iff x < a.B^n - // - let dega,degx = degree a,degree x - if degx < dega + n then 0 else // possible with "normalisation" - let aa,xa = a.digits,x.digits - let f = - if dega = 0 then // a = a0 - if degx = n then - xa.[n] / aa.[0] - else ( -#if CHECKED - check (degx = n+1) "removeFactor degx#1"; -#endif - let f64 = (int64 xa.[degx] * baseNi64 + int64 xa.[degx-1]) / int64 aa.[0] - int32 f64 - ) - else // a = sumR 0 dega (\i.digitsi.B^i) - if degx = dega + n then - xa.[degx] / (aa.[dega] + 1) // +1 to bound above a - else ( -#if CHECKED - check (degx = dega+n+1) "removeFactor degx#2"; -#endif - let f64 = (int64 xa.[degx] * baseNi64 + int64 xa.[degx-1]) - / (int64 aa.[dega] + 1L) // +1 to bound above a - int32 f64 - ) - - if f = 0 then - let lte = (shiftCompare a n x 0) <> 1 - if lte then 1 else 0 - else - f - - -//---------------------------------------------------------------------------- -// division - divmod -//-------------------------------------------------------------------------- - - let divmod b a = - // Returns d,r where b = d.digits + r and r0 then - scaleSubInPlace x f a n; - scaleAddInPlace d f one n; - Invariant(d,x,n,p) - else - finished <- f=0 && n=0; - if not finished then - if p = m+n then - Invariant(d,x,n-1,p); - n <- n-1 - else - Invariant(d,x,n-1,p-1); - n <- n-1; - p <- p-1 - // Have: "b = d.digits + x" return d,x - normN d,normN x - - //---------------------------------------------------------------------------- - // div, mod - //-------------------------------------------------------------------------- - - [] - let div b a = fst (divmod b a) - [] - let rem b a = snd (divmod b a) - // rem b a, for small a can do (base mod a) trick - O(N) - - - //---------------------------------------------------------------------------- - // hcf - //-------------------------------------------------------------------------- - - let hcf a b = - // Have: 0 <= a,b since naturals - let rec hcfloop a b = // Require: 0 <= a <= b - if equal zero a then b - else - // Have: 0 < a <= b - let _,r = divmod b a - // Have: r < a from divmod - hcfloop r a // Have: 0 <= r < a - - if lt a b then hcfloop a b // Have: 0 <= a < b - else hcfloop b a // Have: 0 <= b <= a - - //---------------------------------------------------------------------------- - // pow - //-------------------------------------------------------------------------- - - let two = embed 2 - let powi x n = - let rec power acc x n = - if n=0 then acc - elif n % 2=0 then power acc (mul x x) (n / 2) - else power (mul x acc) (mul x x) (n / 2) - - power one x n - - let pow x n = - let rec power acc x n = - if isZero n then acc - else - let ndiv2,nmod2 = divmod n two // use: intdivmod when available - if isZero nmod2 then power acc (mul x x) ndiv2 - else power (mul x acc) (mul x x) ndiv2 - - power one x n - -//---------------------------------------------------------------------------- -// float n -//-------------------------------------------------------------------------- - - let toFloat n = - let basef = float baseN - let rec evalFloat acc k i = - if i = n.bound then - acc - else - evalFloat (acc + k * float n.digits.[i]) (k * basef) (i+1) - evalFloat 0.0 1.0 0 - -//---------------------------------------------------------------------------- -// n <-> int -//-------------------------------------------------------------------------- - - let ofInt32 n = embed n - let ofInt64 n = embed64 n - - /// Convert BigNat to uint32 otherwise OverflowException. - let toUInt32 n = - match n.bound with - | 0 -> 0u - | 1 -> n.digits.[0] |> uint32 - | 2 -> let xA,xB = n.digits.[0],n.digits.[1] - if xB > baseMask32B then raise (System.OverflowException()) - ( uint32 (xA &&& baseMask32A)) + - ((uint32 (xB &&& baseMask32B)) <<< baseShift32B) - | _ -> raise (System.OverflowException()) - - /// Convert BigNat to uint64 otherwise OverflowException. - let toUInt64 n = - match n.bound with - | 0 -> 0UL - | 1 -> n.digits.[0] |> uint64 - | 2 -> let xA,xB = n.digits.[0],n.digits.[1] - ( uint64 (xA &&& baseMask64A)) + - ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) - | 3 -> let xA,xB,xC = n.digits.[0],n.digits.[1],n.digits.[2] - if xC > baseMask64C then raise (System.OverflowException()) - ( uint64 (xA &&& baseMask64A)) + - ((uint64 (xB &&& baseMask64B)) <<< baseShift64B) + - ((uint64 (xC &&& baseMask64C)) <<< baseShift64C) - | _ -> raise (System.OverflowException()) - - -//---------------------------------------------------------------------------- -// n -> string -//-------------------------------------------------------------------------- - - -#if CHECKED - let checks = false -#endif - let toString n = - // Much better complexity than naive_string_of_z. - // It still does "nDigit" calls to (int)divmod, - // but the degree on which it is called halves (not decrements) each time. - // - let degn = degree n - let rec route prior k ten2k = - if degree ten2k > degn - then (k,ten2k) :: prior - else route ((k,ten2k) :: prior) (k+1) (mul ten2k ten2k) - let kten2ks = route [] 0 (embed 10) - let rec collect isLeading digits n = function - | [] -> - // Have 0 <= n < 10^1, so collect a single digit (if needed) - let n = eval n -#if CHECKED - if checks then check (0 <= n) "toString: digit0"; - if checks then check (n <= 9) "toString: digit9"; -#endif - if isLeading && n=0 then digits // suppress leading 0 - else string n :: digits - | (_,ten2k) :: prior -> -#if CHECKED - if checks then check (lt n (mul ten2k ten2k)) "string_of_int: bound n"; -#endif - // Have 0 <= n < (ten2k)^2 and ten2k = 10^(2^k) - let nH,nL = divmod n ten2k -#if CHECKED - if checks then check (lt nH ten2k) "string_of_int: bound nH"; - if checks then check (lt nL ten2k) "string_of_int: bound nL"; -#endif - // Have 0 <= nH,nL < (ten2k) and ten2k = 10^(2^k) - if isLeading && isZero nH then - // suppress leading 0s - let digits = collect isLeading digits nL prior - digits - else - let digits = collect false digits nL prior - let digits = collect isLeading digits nH prior - digits - - let prior = kten2ks - let digits = collect true [] n prior - match digits with - | [] -> "0" - | _ -> digits |> Array.ofList |> System.String.Concat - -//---------------------------------------------------------------------------- -// n <- string -//-------------------------------------------------------------------------- - - let ofString (str:string) = - // Would it be better to split string half and combine results? - let len = str.Length - if System.String.IsNullOrEmpty str then invalidArg "str" "empty string"; - let ten = embed 10 - let rec build acc i = - if i=len then - acc - else - let c = str.[i] - let d = int c - int '0' - if 0 <= d && d <= 9 then - build (add (mul ten acc) (embed d)) (i+1) - else - raise (new System.FormatException(SR.GetString(SR.badFormatString))) - - build (embed 0) 0 - - let isSmall n = (n.bound <= 1) - let getSmall n = index n 0 - - //---------------------------------------------------------------------------- - // factorial - //-------------------------------------------------------------------------- - - let factorial n = - //***** - // Factorial(n) = 1.2.3.....(n-1).n - // - // Factorial is sometimes used as a test for multiplication. - // The QuickMul FFT multiplier takes over only when both operands reach a given size. - // How to compute factorial? - // - // (a) Factorial(n) = factorial(n-1).n - // This is unlikely to make use of the FFT (n never large enough). - // (b) Factorial(n) = (1.2.3.4....k) . (k.[k+1]...(n-1).n) - // Applied recursively QuickMul FFT will take over on large products. - // - //**** - let rec productR a b = - if equal a b then a - else - let m = div (add a b) (ofInt32 2) - mul (productR a m) (productR (add m one) b) - - productR one n - - -#endif diff --git a/src/fsharp/FSharp.Core/math/n.fsi b/src/fsharp/FSharp.Core/math/n.fsi deleted file mode 100644 index 78f44e6d4f..0000000000 --- a/src/fsharp/FSharp.Core/math/n.fsi +++ /dev/null @@ -1,59 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Math - -#if FX_NO_BIGINT -open Microsoft.FSharp.Collections -open Microsoft.FSharp.Core - -/// Abstract internal type -[] -type internal BigNat - -module internal BigNatModule = - - val zero : BigNat - val one : BigNat - val two : BigNat - - val add : BigNat -> BigNat -> BigNat - val sub : BigNat -> BigNat -> BigNat - val mul : BigNat -> BigNat -> BigNat - val divmod : BigNat -> BigNat -> BigNat * BigNat - val div : BigNat -> BigNat -> BigNat - val rem : BigNat -> BigNat -> BigNat - val hcf : BigNat -> BigNat -> BigNat - - val min : BigNat -> BigNat -> BigNat - val max : BigNat -> BigNat -> BigNat - val scale : int -> BigNat -> BigNat - val powi : BigNat -> int -> BigNat - val pow : BigNat -> BigNat -> BigNat - - val IsZero : BigNat -> bool - val isZero : BigNat -> bool - val isOne : BigNat -> bool - val equal : BigNat -> BigNat -> bool - val compare : BigNat -> BigNat -> int - val lt : BigNat -> BigNat -> bool - val gt : BigNat -> BigNat -> bool - val lte : BigNat -> BigNat -> bool - val gte : BigNat -> BigNat -> bool - - val hash : BigNat -> int - val toFloat : BigNat -> float - val ofInt32 : int -> BigNat - val ofInt64 : int64 -> BigNat - val toString : BigNat -> string - val ofString : string -> BigNat - - val toUInt32 : BigNat -> uint32 - val toUInt64 : BigNat -> uint64 - - val factorial : BigNat -> BigNat - // val randomBits : int -> BigNat - val bits : BigNat -> int - val isSmall : BigNat -> bool (* will fit in int32 (but not nec all int32) *) - val getSmall : BigNat -> int32 (* get the value, if it satisfies isSmall *) - -#endif diff --git a/src/fsharp/FSharp.Core/math/z.fs b/src/fsharp/FSharp.Core/math/z.fs index c9e9614b3d..fa65994315 100644 --- a/src/fsharp/FSharp.Core/math/z.fs +++ b/src/fsharp/FSharp.Core/math/z.fs @@ -1,337 +1,19 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. #nowarn "44" // This construct is deprecated. This function is for use by compiled F# code and should not be used directly -namespace System.Numerics -#if FX_NO_BIGINT - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Primitives.Basics - open Microsoft.FSharp.Math - open System - open System.Globalization - - - // INVARIANT: signInt = 1 or -1 - // value(z) = signInt * v - // NOTE: 0 has two repns (+1,0) or (-1,0). - [] - [] -#if !NETSTANDARD - [] -#endif - type BigInteger(signInt:int, v : BigNat) = - - static let smallLim = 4096 - static let smallPosTab = Array.init smallLim BigNatModule.ofInt32 - static let one = BigInteger(1) - static let zero = BigInteger(0) - - static member internal nat n = - if BigNatModule.isSmall n && BigNatModule.getSmall n < smallLim - then smallPosTab.[BigNatModule.getSmall n] - else n - - static member internal create (s,n) = BigInteger(s,BigInteger.nat n) - - static member internal posn n = BigInteger(1,BigInteger.nat n) - - static member internal negn n = BigInteger(-1,BigInteger.nat n) - - member x.Sign = if x.IsZero then 0 else signInt - - member x.SignInt = signInt - - member internal x.V = v - - static member op_Equality (x:BigInteger, y:BigInteger) = - //System.Console.WriteLine("x = {0}",box x) - //System.Console.WriteLine("y = {0}",box y) - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.equal x.V y.V // +1.xv = +1.yv iff xv = yv - | -1, -1 -> BigNatModule.equal x.V y.V // -1.xv = -1.yv iff xv = yv - | 1,-1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv = -1.yv iff xv=0 and yv=0 - | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // -1.xv = 1.yv iff xv=0 and yv=0 - | 0, 0 -> true - | 0, 1 -> BigNatModule.isZero y.V - | 0, -1 -> BigNatModule.isZero y.V - | 1, 0 -> BigNatModule.isZero x.V - | -1, 0 -> BigNatModule.isZero x.V - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_Inequality (x:BigInteger, y:BigInteger) = not (BigInteger.op_Equality(x,y)) // CA2226: OperatorsShouldHaveSymmetricalOverloads - - static member op_LessThan (x:BigInteger, y:BigInteger) = - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.lt x.V y.V // 1.xv < 1.yv iff xv < yv - | -1,-1 -> BigNatModule.lt y.V x.V // -1.xv < -1.yv iff yv < xv - | 1,-1 -> false // 1.xv < -1.yv iff 0 <= 1.xv < -1.yv <= 0 iff false - | -1, 1 -> not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) - // -1.xv < 1.yv - // (a) xv=0 and yv=0, then false - // (b) xv<>0, -1.xv < 0 <= 1.yv, so true - // (c) yv<>0, -1.xv <= 0 < 1.yv, so true - | 0, 0 -> false - | 0, 1 -> not (BigNatModule.isZero y.V) - | 0,-1 -> false - | 1, 0 -> false - | -1, 0 -> not (BigNatModule.isZero x.V) - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_GreaterThan (x:BigInteger, y:BigInteger) = // Follow lt by +/- symmetry - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.gt x.V y.V - | -1,-1 -> BigNatModule.gt y.V x.V - | 1,-1 -> not (BigNatModule.isZero x.V) || not (BigNatModule.isZero y.V) - | -1, 1 -> false - | 0, 0 -> false - | 0, 1 -> false - | 0,-1 -> not (BigNatModule.isZero y.V) - | 1, 0 -> not (BigNatModule.isZero x.V) - | -1, 0 -> false - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member internal compare(n,nn) = if BigInteger.op_LessThan(n,nn) then -1 elif BigInteger.op_Equality(n,nn) then 0 else 1 - - static member internal hash (z:BigInteger) = - if z.SignInt = 0 then 1 // 1 is hashcode for initialized BigInteger.Zero - else z.SignInt + BigNatModule.hash(z.V) - - override x.ToString() = - match x.SignInt with - | 1 -> BigNatModule.toString x.V // positive - | -1 -> - if BigNatModule.isZero x.V - then "0" // not negative in fact, but zero. - else "-" + BigNatModule.toString x.V // negative - | 0 -> "0" - | _ -> invalidOp "signs should be +/- 1 or 0" - - member x.StructuredDisplayString = x.ToString() - - interface System.IComparable with - member this.CompareTo(obj:obj) = - match obj with - | :? BigInteger as that -> BigInteger.compare(this,that) - | _ -> invalidArg "obj" "the objects are not comparable" - - override this.Equals(obj) = - match obj with - | :? BigInteger as that -> BigInteger.op_Equality(this, that) - | _ -> false - - override x.GetHashCode() = BigInteger.hash(x) - - new (n:int) = - if n>=0 - then BigInteger (1,BigInteger.nat(BigNatModule.ofInt32 n)) - elif (n = System.Int32.MinValue) - then BigInteger(-1,BigInteger.nat(BigNatModule.ofInt64 (-(int64 n)))) - else BigInteger(-1,BigInteger.nat(BigNatModule.ofInt32 (-n))) - - new (n:int64) = - if n>=0L - then BigInteger(1,BigInteger.nat (BigNatModule.ofInt64 n)) - elif (n = System.Int64.MinValue) - then BigInteger(-1,BigInteger.nat (BigNatModule.add (BigNatModule.ofInt64 System.Int64.MaxValue) BigNatModule.one) ) - else BigInteger(-1,BigInteger.nat (BigNatModule.ofInt64 (-n))) - - static member One = one +namespace Microsoft.FSharp.Math - static member Zero = zero - - static member (~-) (z:BigInteger) = - match z.SignInt with - | 0 -> BigInteger.Zero - | i -> BigInteger.create(-i, z.V) - - static member Scale(k, z:BigInteger) = - if z.SignInt = 0 then BigInteger.Zero else - if k<0 - then BigInteger.create(-z.SignInt, (BigNatModule.scale (-k) z.V)) // k.zsign.zv = -zsign.(-k.zv) - else BigInteger.create(z.SignInt, (BigNatModule.scale k z.V)) // k.zsign.zv = zsign.k.zv - - // Result: 1.nx - 1.ny (integer subtraction) - static member internal subnn (nx,ny) = - if BigNatModule.gte nx ny - then BigInteger.posn (BigNatModule.sub nx ny) // nx >= ny, result +ve, +1.(nx - ny) - else BigInteger.negn (BigNatModule.sub ny nx) // nx < ny, result -ve, -1.(ny - nx) - - static member internal addnn (nx,ny) = - BigInteger.posn (BigNatModule.add nx ny) // Compute "nx + ny" to be integer - - member x.IsZero = x.SignInt = 0 || BigNatModule.isZero x.V - - member x.IsOne = (x.SignInt = 1) && BigNatModule.isOne x.V // signx.xv = 1 iff signx = +1 and xv = 1 - - static member (+) (x:BigInteger,y:BigInteger) = - if y.IsZero then x else - if x.IsZero then y else - match x.SignInt,y.SignInt with - | 1, 1 -> BigInteger.addnn(x.V,y.V) // 1.xv + 1.yv = (xv + yv) - | -1,-1 -> -(BigInteger.addnn(x.V,y.V)) // -1.xv + -1.yv = -(xv + yv) - | 1,-1 -> BigInteger.subnn (x.V,y.V) // 1.xv + -1.yv = (xv - yv) - | -1, 1 -> BigInteger.subnn(y.V,x.V) // -1.xv + 1.yv = (yv - xv) - | _ -> invalidArg "x" "signs should be +/- 1" - - static member (-) (x:BigInteger,y:BigInteger) = - if y.IsZero then x else - if x.IsZero then -y else - match x.SignInt,y.SignInt with - | 1, 1 -> BigInteger.subnn(x.V,y.V) // 1.xv - 1.yv = (xv - yv) - | -1,-1 -> BigInteger.subnn(y.V,x.V) // -1.xv - -1.yv = (yv - xv) - | 1,-1 -> BigInteger.addnn(x.V,y.V) // 1.xv - -1.yv = (xv + yv) - | -1, 1 -> -(BigInteger.addnn(x.V,y.V)) // -1.xv - 1.yv = -(xv + yv) - | _ -> invalidArg "x" "signs should be +/- 1" - - static member ( * ) (x:BigInteger,y:BigInteger) = - if x.IsZero then x - elif y.IsZero then y - elif x.IsOne then y - elif y.IsOne then x - else - let m = (BigNatModule.mul x.V y.V) - BigInteger.create (x.SignInt * y.SignInt,m) // xsign.xv * ysign.yv = (xsign.ysign).(xv.yv) - - static member DivRem (x:BigInteger, y:BigInteger, []rem:BigInteger byref) = - if y.IsZero then raise (new System.DivideByZeroException()) - if x.IsZero then - rem <- BigInteger.Zero - BigInteger.Zero - else - let d,r = BigNatModule.divmod x.V y.V - // HAVE: |x| = d.|y| + r and 0 <= r < |y| - // HAVE: xv = d.yv + r and 0 <= r < yv - match x.SignInt,y.SignInt with - | 1, 1 -> rem <- BigInteger.posn r ; BigInteger.posn d // 1.xv = 1.d.( 1.yv) + ( 1.r) - | -1,-1 -> rem <- BigInteger.negn r ; BigInteger.posn d // -1.xv = 1.d.(-1.yv) + (-1.r) - | 1,-1 -> rem <- BigInteger.posn r ; BigInteger.negn d // 1.xv = -1.d.(-1.yv) + ( 1.r) - | -1, 1 -> rem <- BigInteger.negn r ; BigInteger.negn d // -1.xv = -1.d.( 1.yv) + (-1.r) - | _ -> invalidArg "x" "signs should be +/- 1" - - static member (/) (x:BigInteger,y:BigInteger) = - let mutable rem = new BigInteger(0) - BigInteger.DivRem(x,y,&rem) - - static member (%) (x:BigInteger,y:BigInteger) = - let mutable rem = new BigInteger(0) - BigInteger.DivRem(x,y,&rem) |> ignore ; rem - - static member GreatestCommonDivisor (x:BigInteger,y:BigInteger) = - match x.SignInt,y.SignInt with - | 0, 0 -> BigInteger.Zero - | 0, _ -> BigInteger.posn y.V - | _, 0 -> BigInteger.posn x.V - | _ -> BigInteger.posn (BigNatModule.hcf x.V y.V) // hcf (xsign.xv,ysign.yv) = hcf (xv,yv) - - member x.IsNegative = x.SignInt = -1 && not (x.IsZero) // signx.xv < 0 iff signx = -1 and xv<>0 - - member x.IsPositive = x.SignInt = 1 && not (x.IsZero) // signx.xv > 0 iff signx = +1 and xv<>0 - - static member Abs (x:BigInteger) = if x.SignInt = -1 then -x else x - - static member op_LessThanOrEqual (x:BigInteger,y:BigInteger) = - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.lte x.V y.V // 1.xv <= 1.yv iff xv <= yv - | -1,-1 -> BigNatModule.lte y.V x.V // -1.xv <= -1.yv iff yv <= xv - | 1,-1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V // 1.xv <= -1.yv, - // (a) if xv=0 and yv=0 then true - // (b) otherwise false, only meet at zero. - - | -1, 1 -> true // -1.xv <= 1.yv, true - | 0, 0 -> true - | 1, 0 -> BigNatModule.isZero x.V - | -1, 0 -> true - | 0, 1 -> true - | 0,-1 -> BigNatModule.isZero y.V - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member op_GreaterThanOrEqual (x:BigInteger,y:BigInteger) = // Follow lte by +/- symmetry - match x.SignInt,y.SignInt with - | 1, 1 -> BigNatModule.gte x.V y.V - | -1,-1 -> BigNatModule.gte y.V x.V - | 1,-1 -> true - | -1, 1 -> BigNatModule.isZero x.V && BigNatModule.isZero y.V - | 0, 0 -> true - | 1, 0 -> true - | -1, 0 -> BigNatModule.isZero x.V - | 0, 1 -> BigNatModule.isZero y.V - | 0,-1 -> true - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member Pow (x:BigInteger,y:int32) = - if y < 0 then raise (new System.ArgumentOutOfRangeException("y", (SR.GetString(SR.inputMustBeNonNegative)))) - match x.IsZero, y with - | true, 0 -> BigInteger.One - | true, _ -> BigInteger.Zero - | _ -> - let yval = BigInteger(y) - BigInteger.create ((if BigNatModule.isZero (BigNatModule.rem yval.V BigNatModule.two) then 1 else x.SignInt), BigNatModule.pow x.V yval.V) - - static member op_Explicit (x:BigInteger) = - if x.IsZero then 0 else - let u = BigNatModule.toUInt32 x.V - if u <= uint32 System.Int32.MaxValue then - // Handle range [-MaxValue,MaxValue] - x.SignInt * int32 u - elif x.SignInt = -1 && u = uint32 (System.Int32.MaxValue + 1) then - //assert(System.Int32.MinValue = 0 - System.Int32.MaxValue - 1) - // Handle MinValue = -(MaxValue+1) special case not covered by the above - System.Int32.MinValue - else - raise (System.OverflowException()) - - static member op_Explicit (x:BigInteger) = - if x.IsZero then 0L else - let u = BigNatModule.toUInt64 x.V - if u <= uint64 System.Int64.MaxValue then - (* Handle range [-MaxValue,MaxValue] *) - int64 x.SignInt * int64 u - elif x.SignInt = -1 && u = uint64 (System.Int64.MaxValue + 1L) then - //assert(System.Int64.MinValue = 0 - System.Int64.MaxValue - 1L) - (* Handle MinValue = -(MaxValue+1) special case not covered by the above *) - System.Int64.MinValue - else - raise (System.OverflowException()) - - static member op_Explicit (x:BigInteger) = - match x.SignInt with - | 1 -> BigNatModule.toFloat x.V // float (1.xv) = float (xv) - | -1 -> - (BigNatModule.toFloat x.V) // float (-1.xv) = - float (xv) - | 0 -> 0. - | _ -> invalidArg "x" "signs should be +/- 1 or 0" - - static member Parse(text:string) = - if isNull text then raise (new ArgumentNullException("text")) - let text = text.Trim() - let len = text.Length - if len = 0 then raise (new System.FormatException(SR.GetString(SR.badFormatString))) - match text.[0], len with - | '-', 1 -> raise (new System.FormatException(SR.GetString(SR.badFormatString))) - | '-', _ -> BigInteger.negn (BigNatModule.ofString text.[1..len-1]) - | '+', 1 -> raise (new System.FormatException(SR.GetString(SR.badFormatString))) - | '+', _ -> BigInteger.posn (BigNatModule.ofString text.[1..len-1]) - | _ -> BigInteger.posn (BigNatModule.ofString text) - - member internal x.IsSmall = x.IsZero || BigNatModule.isSmall (x.V) - - static member Factorial (x:BigInteger) = - if x.IsNegative then invalidArg "x" (SR.GetString(SR.inputMustBeNonNegative)) - if x.IsPositive then BigInteger.posn (BigNatModule.factorial x.V) - else BigInteger.One - - static member ( ~+ )(n1:BigInteger) = n1 - - static member FromInt64(x:int64) = new BigInteger(x) - - static member FromInt32(x:int32) = new BigInteger(x) -#endif +// Deliberately left empty +// +// FSharp.Core previously exposed the namespace Microsoft.FSharp.Math even though there were no types in it. +// This retains that. +// Existing programs could, and did contain the line: +// open FSharp.Math +// namespace Microsoft.FSharp.Core - type bigint = System.Numerics.BigInteger open System @@ -341,22 +23,6 @@ namespace Microsoft.FSharp.Core open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open System.Numerics -#if FX_NO_BIGINT - // FxCop suppressions - [] - [] - [] - [] - [] - [] - [] - [] - [] - [] - [] - do() -#endif - [] module NumericLiterals = @@ -402,14 +68,10 @@ namespace Microsoft.FSharp.Core res else let v = -#if FX_NO_BIGINT - BigInteger.Parse s -#else if isOX s then BigInteger.Parse (s.[2..],NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture) else BigInteger.Parse (s,NumberStyles.AllowLeadingSign,CultureInfo.InvariantCulture) -#endif res <- v tabParse.[s] <- res res) @@ -421,5 +83,3 @@ namespace Microsoft.FSharp.Core (FromStringDynamic text :?> 'T) when 'T : BigInteger = getParse text - - diff --git a/src/fsharp/FSharp.Core/math/z.fsi b/src/fsharp/FSharp.Core/math/z.fsi index 3ea6327638..e49b1b3d53 100644 --- a/src/fsharp/FSharp.Core/math/z.fsi +++ b/src/fsharp/FSharp.Core/math/z.fsi @@ -1,82 +1,14 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace System.Numerics -#if FX_NO_BIGINT - - open System - open Microsoft.FSharp.Collections - open Microsoft.FSharp.Core - - /// The type of arbitrary-sized integers - [] - [] - type BigInteger = - /// Return the sum of two big integers - static member ( + ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the modulus of big integers - static member ( % ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the product of big integers - static member ( * ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the difference of two big integers - static member ( - ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the ratio of two big integers - static member ( / ) : x:BigInteger * y:BigInteger -> BigInteger - /// Return the negation of a big integer - static member (~-) : x:BigInteger -> BigInteger - /// Return the given big integer - static member (~+) : x:BigInteger -> BigInteger - /// Convert a big integer to a floating point number - static member op_Explicit : x:BigInteger -> float - /// Convert a big integer to a 64-bit signed integer - static member op_Explicit : x:BigInteger -> int64 - /// Convert a big integer to a 32-bit signed integer - static member op_Explicit : x:BigInteger -> int32 - /// Parse a big integer from a string format - static member Parse : text:string -> BigInteger - /// Return the sign of a big integer: 0, +1 or -1 - member Sign : int - /// Compute the ratio and remainder of two big integers - static member DivRem : x:BigInteger * y:BigInteger * []rem:BigInteger byref -> BigInteger - - /// This operator is for consistency when this type be used from other CLI languages - static member op_LessThan : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_LessThanOrEqual : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_GreaterThan : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_GreaterThanOrEqual : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_Equality : x:BigInteger * y:BigInteger -> bool - /// This operator is for consistency when this type be used from other CLI languages - static member op_Inequality : x:BigInteger * y:BigInteger -> bool - - /// Return the greatest common divisor of two big integers - static member GreatestCommonDivisor : x:BigInteger * y:BigInteger -> BigInteger - /// Return n^m for two big integers - static member Pow : x:BigInteger * y:int32 -> BigInteger - /// Compute the absolute value of a big integer - static member Abs : x:BigInteger -> BigInteger - /// Get the big integer for zero - static member Zero : BigInteger - /// Get the big integer for one - static member One : BigInteger - - /// Return true if a big integer is 'zero' - member IsZero : bool - /// Return true if a big integer is 'one' - member IsOne : bool - interface System.IComparable - override Equals : obj -> bool - override GetHashCode : unit -> int - override ToString : unit -> string - - /// Construct a BigInteger value for the given integer - new : x:int -> BigInteger - /// Construct a BigInteger value for the given 64-bit integer - new : x:int64 -> BigInteger -#endif +namespace Microsoft.FSharp.Math +// Deliberately left empty +// +// FSharp.Core previously exposed the namespace Microsoft.FSharp.Math even though there were no types in it. +// This retains that. +// Existing programs could, and did contain the line: +// open FSharp.Math +// namespace Microsoft.FSharp.Core @@ -104,5 +36,3 @@ namespace Microsoft.FSharp.Core val FromInt64Dynamic : value:int64 -> obj /// Provides a default implementations of F# numeric literal syntax for literals of the form 'dddI' val FromStringDynamic : text:string -> obj - - diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 2e91dec124..542852e5da 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -374,29 +374,6 @@ namespace Microsoft.FSharp.Core /// Represents a out-argument managed pointer in F# code. This type should only be used with F# 4.5+. type outref<'T> = byref<'T, ByRefKinds.Out> -#if FX_RESHAPED_REFLECTION - module PrimReflectionAdapters = - - open System.Reflection - open System.Linq - // copied from BasicInlinedOperations - let inline box (x:'T) = (# "box !0" type ('T) x : obj #) - let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #) - type System.Type with - member inline this.IsGenericType = this.GetTypeInfo().IsGenericType - member inline this.IsValueType = this.GetTypeInfo().IsValueType - member inline this.IsSealed = this.GetTypeInfo().IsSealed - member inline this.IsAssignableFrom(otherType: Type) = this.GetTypeInfo().IsAssignableFrom(otherType.GetTypeInfo()) - member inline this.GetGenericArguments() = this.GetTypeInfo().GenericTypeArguments - member inline this.GetProperty(name) = this.GetRuntimeProperty(name) - member inline this.GetMethod(name, parameterTypes) = this.GetRuntimeMethod(name, parameterTypes) - member inline this.GetCustomAttributes(attributeType: Type, inherits: bool) : obj[] = - unboxPrim<_> (box (CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attributeType, inherits).ToArray())) - - open PrimReflectionAdapters - -#endif - module internal BasicInlinedOperations = let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #) let inline box (x:'T) = (# "box !0" type ('T) x : obj #) @@ -548,12 +525,8 @@ namespace Microsoft.FSharp.Core ignore obj // pretend the variable is used let e = new System.ArgumentException(ErrorStrings.AddressOpNotFirstClassString) (# "throw" (e :> System.Exception) : nativeptr<'T> #) - - + open IntrinsicOperators -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters -#endif [] // nested module OK module IntrinsicFunctions = @@ -881,78 +854,6 @@ namespace Microsoft.FSharp.Core /// specialcase: Core implementation of structural comparison on arbitrary arrays. and GenericComparisonArbArrayWithComparer (comp:GenericComparer) (x:System.Array) (y:System.Array) : int = -#if FX_NO_ARRAY_LONG_LENGTH - if x.Rank = 1 && y.Rank = 1 then - let lenx = x.Length - let leny = y.Length - let c = intOrder lenx leny - if c <> 0 then c else - let basex = (x.GetLowerBound(0)) - let basey = (y.GetLowerBound(0)) - let c = intOrder basex basey - if c <> 0 then c else - let rec check i = - if i >= lenx then 0 else - let c = GenericCompare comp ((x.GetValue(i + basex)),(y.GetValue(i + basey))) - if c <> 0 then c else check (i + 1) - check 0 - elif x.Rank = 2 && y.Rank = 2 then - let lenx0 = x.GetLength(0) - let leny0 = y.GetLength(0) - let c = intOrder lenx0 leny0 - if c <> 0 then c else - let lenx1 = x.GetLength(1) - let leny1 = y.GetLength(1) - let c = intOrder lenx1 leny1 - if c <> 0 then c else - let basex0 = (x.GetLowerBound(0)) - let basex1 = (x.GetLowerBound(1)) - let basey0 = (y.GetLowerBound(0)) - let basey1 = (y.GetLowerBound(1)) - let c = intOrder basex0 basey0 - if c <> 0 then c else - let c = intOrder basex1 basey1 - if c <> 0 then c else - let rec check0 i = - let rec check1 j = - if j >= lenx1 then 0 else - let c = GenericCompare comp ((x.GetValue(i + basex0,j + basex1)), (y.GetValue(i + basey0,j + basey1))) - if c <> 0 then c else check1 (j + 1) - if i >= lenx0 then 0 else - let c = check1 0 - if c <> 0 then c else - check0 (i + 1) - check0 0 - else - let c = intOrder x.Rank y.Rank - if c <> 0 then c else - let ndims = x.Rank - // check lengths - let rec precheck k = - if k >= ndims then 0 else - let c = intOrder (x.GetLength(k)) (y.GetLength(k)) - if c <> 0 then c else - let c = intOrder (x.GetLowerBound(k)) (y.GetLowerBound(k)) - if c <> 0 then c else - precheck (k+1) - let c = precheck 0 - if c <> 0 then c else - let idxs : int[] = zeroCreate ndims - let rec checkN k baseIdx i lim = - if i >= lim then 0 else - set idxs k (baseIdx + i) - let c = - if k = ndims - 1 - then GenericCompare comp ((x.GetValue(idxs)), (y.GetValue(idxs))) - else check (k+1) - if c <> 0 then c else - checkN k baseIdx (i + 1) lim - and check k = - if k >= ndims then 0 else - let baseIdx = x.GetLowerBound(k) - checkN k baseIdx 0 (x.GetLength(k)) - check 0 -#else if x.Rank = 1 && y.Rank = 1 then let lenx = x.LongLength let leny = y.LongLength @@ -985,11 +886,11 @@ namespace Microsoft.FSharp.Core let c = int64Order basex1 basey1 if c <> 0 then c else let rec check0 i = - let rec check1 j = + let rec check1 j = if j >=. lenx1 then 0 else let c = GenericCompare comp ((x.GetValue(i +. basex0,j +. basex1)), (y.GetValue(i +. basey0,j +. basey1))) if c <> 0 then c else check1 (j +. 1L) - if i >=. lenx0 then 0 else + if i >=. lenx0 then 0 else let c = check1 0L if c <> 0 then c else check0 (i +. 1L) @@ -998,8 +899,8 @@ namespace Microsoft.FSharp.Core let c = intOrder x.Rank y.Rank if c <> 0 then c else let ndims = x.Rank - // check lengths - let rec precheck k = + // check lengths + let rec precheck k = if k >= ndims then 0 else let c = int64Order (x.GetLongLength(k)) (y.GetLongLength(k)) if c <> 0 then c else @@ -1023,10 +924,9 @@ namespace Microsoft.FSharp.Core let baseIdx = x.GetLowerBound(k) checkN k (int64 baseIdx) 0L (x.GetLongLength(k)) check 0 -#endif - + /// optimized case: Core implementation of structural comparison on object arrays. - and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = + and GenericComparisonObjArrayWithComparer (comp:GenericComparer) (x:obj[]) (y:obj[]) : int = let lenx = x.Length let leny = y.Length let c = intOrder lenx leny @@ -1035,8 +935,8 @@ namespace Microsoft.FSharp.Core let mutable i = 0 let mutable res = 0 while i < lenx do - let c = GenericCompare comp ((get x i), (get y i)) - if c <> 0 then (res <- c; i <- lenx) + let c = GenericCompare comp ((get x i), (get y i)) + if c <> 0 then (res <- c; i <- lenx) else i <- i + 1 res @@ -1058,7 +958,7 @@ namespace Microsoft.FSharp.Core type GenericComparer with interface System.Collections.IComparer with override c.Compare(x:obj,y:obj) = GenericCompare c (x,y) - + /// The unique object for comparing values in PER mode (where local exceptions are thrown when NaNs are compared) let fsComparerPER = GenericComparer(true) @@ -1403,63 +1303,6 @@ namespace Microsoft.FSharp.Core /// specialcase: Core implementation of structural equality on arbitrary arrays. and GenericEqualityArbArray er (iec:System.Collections.IEqualityComparer) (x:System.Array) (y:System.Array) : bool = -#if FX_NO_ARRAY_LONG_LENGTH - if x.Rank = 1 && y.Rank = 1 then - // check lengths - let lenx = x.Length - let leny = y.Length - (int32Eq lenx leny) && - // check contents - let basex = x.GetLowerBound(0) - let basey = y.GetLowerBound(0) - (int32Eq basex basey) && - let rec check i = (i >= lenx) || (GenericEqualityObj er iec ((x.GetValue(basex + i)),(y.GetValue(basey + i))) && check (i + 1)) - check 0 - elif x.Rank = 2 && y.Rank = 2 then - // check lengths - let lenx0 = x.GetLength(0) - let leny0 = y.GetLength(0) - (int32Eq lenx0 leny0) && - let lenx1 = x.GetLength(1) - let leny1 = y.GetLength(1) - (int32Eq lenx1 leny1) && - let basex0 = x.GetLowerBound(0) - let basex1 = x.GetLowerBound(1) - let basey0 = y.GetLowerBound(0) - let basey1 = y.GetLowerBound(1) - (int32Eq basex0 basey0) && - (int32Eq basex1 basey1) && - // check contents - let rec check0 i = - let rec check1 j = (j >= lenx1) || (GenericEqualityObj er iec ((x.GetValue(basex0 + i,basex1 + j)), (y.GetValue(basey0 + i,basey1 + j))) && check1 (j + 1)) - (i >= lenx0) || (check1 0 && check0 (i + 1)) - check0 0 - else - (x.Rank = y.Rank) && - let ndims = x.Rank - // check lengths - let rec precheck k = - (k >= ndims) || - (int32Eq (x.GetLength(k)) (y.GetLength(k)) && - int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) && - precheck (k+1)) - precheck 0 && - let idxs : int32[] = zeroCreate ndims - // check contents - let rec checkN k baseIdx i lim = - (i >= lim) || - (set idxs k (baseIdx + i); - (if k = ndims - 1 - then GenericEqualityObj er iec ((x.GetValue(idxs)),(y.GetValue(idxs))) - else check (k+1)) && - checkN k baseIdx (i + 1) lim) - and check k = - (k >= ndims) || - (let baseIdx = x.GetLowerBound(k) - checkN k baseIdx 0 (x.GetLength(k))) - - check 0 -#else if x.Rank = 1 && y.Rank = 1 then // check lengths let lenx = x.LongLength @@ -1468,9 +1311,9 @@ namespace Microsoft.FSharp.Core // check contents let basex = int64 (x.GetLowerBound(0)) let basey = int64 (y.GetLowerBound(0)) - (int64Eq basex basey) && + (int64Eq basex basey) && let rec check i = (i >=. lenx) || (GenericEqualityObj er iec ((x.GetValue(basex +. i)),(y.GetValue(basey +. i))) && check (i +. 1L)) - check 0L + check 0L elif x.Rank = 2 && y.Rank = 2 then // check lengths let lenx0 = x.GetLongLength(0) @@ -1491,16 +1334,16 @@ namespace Microsoft.FSharp.Core (i >=. lenx0) || (check1 0L && check0 (i +. 1L)) check0 0L else - (x.Rank = y.Rank) && + (x.Rank = y.Rank) && let ndims = x.Rank - // check lengths - let rec precheck k = - (k >= ndims) || - (int64Eq (x.GetLongLength(k)) (y.GetLongLength(k)) && - int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) && + // check lengths + let rec precheck k = + (k >= ndims) || + (int64Eq (x.GetLongLength(k)) (y.GetLongLength(k)) && + int32Eq (x.GetLowerBound(k)) (y.GetLowerBound(k)) && precheck (k+1)) precheck 0 && - let idxs : int64[] = zeroCreate ndims + let idxs : int64[] = zeroCreate ndims // check contents let rec checkN k baseIdx i lim = (i >=. lim) || @@ -1513,10 +1356,8 @@ namespace Microsoft.FSharp.Core (k >= ndims) || (let baseIdx = x.GetLowerBound(k) checkN k (int64 baseIdx) 0L (x.GetLongLength(k))) - check 0 -#endif - + /// optimized case: Core implementation of structural equality on object arrays. and GenericEqualityObjArray er iec (x:obj[]) (y:obj[]) : bool = let lenx = x.Length @@ -2395,13 +2236,11 @@ namespace Microsoft.FSharp.Core then p <- p + 1; -1L else 1L - let parseOctalUInt64 (s:string) p l = - let rec parse n acc = if n < l then parse (n+1) (acc *.. 8UL +.. (let c = s.Chars(n) in if c >=... '0' && c <=... '7' then Convert.ToUInt64(c) -.. Convert.ToUInt64('0') else formatError())) else acc in - parse p 0UL - - let parseBinaryUInt64 (s:string) p l = - let rec parse n acc = if n < l then parse (n+1) (acc *.. 2UL +.. (match s.Chars(n) with '0' -> 0UL | '1' -> 1UL | _ -> formatError())) else acc in - parse p 0UL + let parseBinaryUInt64 (s:string) = + Convert.ToUInt64(s, 2) + + let parseOctalUInt64 (s:string) = + Convert.ToUInt64(s, 8) let inline removeUnderscores (s:string) = match s with @@ -2418,8 +2257,8 @@ namespace Microsoft.FSharp.Core if p >= l then formatError() else match specifier with | 'x' -> UInt32.Parse( s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture) - | 'b' -> Convert.ToUInt32(parseBinaryUInt64 s p l) - | 'o' -> Convert.ToUInt32(parseOctalUInt64 s p l) + | 'b' -> Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p))) + | 'o' -> Convert.ToUInt32(parseOctalUInt64 (s.Substring(p))) | _ -> UInt32.Parse(s.Substring(p), NumberStyles.Integer, CultureInfo.InvariantCulture) in let inline int32OfUInt32 (x:uint32) = (# "" x : int32 #) @@ -2436,8 +2275,8 @@ namespace Microsoft.FSharp.Core if p >= l then formatError() else match Char.ToLowerInvariant(specifier) with | 'x' -> sign * (int32OfUInt32 (Convert.ToUInt32(UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)))) - | 'b' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseBinaryUInt64 s p l))) - | 'o' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseOctalUInt64 s p l))) + | 'b' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p))))) + | 'o' -> sign * (int32OfUInt32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p))))) | _ -> Int32.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) let ParseInt64 (s:string) = @@ -2451,8 +2290,8 @@ namespace Microsoft.FSharp.Core if p >= l then formatError() else match Char.ToLowerInvariant(specifier) with | 'x' -> sign *. Int64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture) - | 'b' -> sign *. (int64OfUInt64 (parseBinaryUInt64 s p l)) - | 'o' -> sign *. (int64OfUInt64 (parseOctalUInt64 s p l)) + | 'b' -> sign *. (int64OfUInt64 (parseBinaryUInt64 (s.Substring(p)))) + | 'o' -> sign *. (int64OfUInt64 (parseOctalUInt64 (s.Substring(p)))) | _ -> Int64.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) let ParseUInt64 (s:string) : uint64 = @@ -2465,8 +2304,8 @@ namespace Microsoft.FSharp.Core if p >= l then formatError() else match specifier with | 'x' -> UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture) - | 'b' -> parseBinaryUInt64 s p l - | 'o' -> parseOctalUInt64 s p l + | 'b' -> parseBinaryUInt64 (s.Substring(p)) + | 'o' -> parseOctalUInt64 (s.Substring(p)) | _ -> UInt64.Parse(s.Substring(p), NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) @@ -2960,7 +2799,6 @@ namespace Microsoft.FSharp.Core [] static member op_Implicit(func : ('T -> 'Res) ) = new System.Func<'T,'Res>(func) -#if !FX_NO_CONVERTER [] static member op_Implicit(f : System.Converter<_,_>) : ('T -> 'Res) = (fun t -> f.Invoke(t)) @@ -2970,7 +2808,6 @@ namespace Microsoft.FSharp.Core static member FromConverter (converter: System.Converter<_,_>) : ('T -> 'Res) = (fun t -> converter.Invoke(t)) static member ToConverter (func: ('T -> 'Res) ) = new System.Converter<'T,'Res>(func) -#endif static member InvokeFast (func:FSharpFunc<_,_>, arg1: 'T, arg2: 'Res) = OptimizedClosures.invokeFast2(func, arg1, arg2) @@ -2986,9 +2823,7 @@ namespace Microsoft.FSharp.Core static member inline ToFSharpFunc (action: Action<_>) = (fun t -> action.Invoke(t)) -#if !FX_NO_CONVERTER static member inline ToFSharpFunc (converter : Converter<_,_>) = (fun t -> converter.Invoke(t)) -#endif // Note: this is not made public in the signature, because of conflicts with the Converter overload. // The method remains in case someone is calling it via reflection. @@ -4268,26 +4103,12 @@ namespace Microsoft.FSharp.Core module Attributes = open System.Runtime.CompilerServices -#if !FX_NO_DEFAULT_DEPENDENCY_TYPE - [] -#endif - -#if !FX_NO_COMVISIBLE [] -#endif [] - -#if BE_SECURITY_TRANSPARENT [] // assembly is fully transparent #if CROSS_PLATFORM_COMPILER #else [] // v4 transparency; soon to be the default, but not yet -#endif -#else -#if !FX_NO_SECURITY_PERMISSIONS - // REVIEW: Need to choose a specific permission for the action to be applied to - [] -#endif #endif do () @@ -4319,6 +4140,9 @@ namespace Microsoft.FSharp.Core [] let inline typeof<'T> = BasicInlinedOperations.typeof<'T> + [] + let inline nameof (_: 'T) : string = raise (Exception "may not call directly, should always be optimized away") + [] let methodhandleof (_call: ('T -> 'TResult)) : System.RuntimeMethodHandle = raise (Exception "may not call directly, should always be optimized away") @@ -4337,7 +4161,6 @@ namespace Microsoft.FSharp.Core [] let id x = x -#if !FX_NO_SYSTEM_CONSOLE // std* are TypeFunctions with the effect of reading the property on instantiation. // So, direct uses of stdout should capture the current System.Console.Out at that point. [] @@ -4348,10 +4171,8 @@ namespace Microsoft.FSharp.Core [] let stderr<'T> = System.Console.Error -#endif - - module Unchecked = + module Unchecked = [] let inline unbox<'T> (v:obj) = unboxPrim<'T> v @@ -4654,13 +4475,10 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (# "conv.ovf.i.un" value : nativeint #) when ^T : byte = (# "conv.ovf.i.un" value : nativeint #) - module OperatorIntrinsics = - + module OperatorIntrinsics = + open System.Collections -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters -#endif - + let notStarted() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) let alreadyFinished() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index c977af4541..7ba3b3ae4d 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1342,20 +1342,6 @@ namespace Microsoft.FSharp.Core [] val inline FastCompareTuple5 : comparer:System.Collections.IComparer -> tuple1:('T1 * 'T2 * 'T3 * 'T4 * 'T5) -> tuple2:('T1 * 'T2 * 'T3 * 'T4 * 'T5) -> int -#if FX_RESHAPED_REFLECTION - module internal PrimReflectionAdapters = - - open System.Reflection - - type System.Type with - member inline IsGenericType : bool - member inline IsValueType : bool - member inline GetMethod : string * parameterTypes : Type[] -> MethodInfo - member inline GetProperty : string -> PropertyInfo - member inline IsAssignableFrom : otherType : Type -> bool - member inline GetCustomAttributes : attributeType : Type * inherits: bool -> obj[] -#endif - //------------------------------------------------------------------------- // F# Choice Types @@ -1503,8 +1489,6 @@ namespace Microsoft.FSharp.Core /// 'U abstract member Invoke : func:'T -> 'U -#if !FX_NO_CONVERTER - /// Convert an F# first class function value to a value of type System.Converter /// The input function. /// A System.Converter of the function type. @@ -1524,7 +1508,6 @@ namespace Microsoft.FSharp.Core /// The input System.Converter. /// An F# function of the same type. static member FromConverter : converter:System.Converter<'T,'U> -> ('T -> 'U) -#endif /// Invoke an F# first class function value with five curried arguments. In some cases this /// will result in a more efficient application than applying the arguments successively. @@ -1575,12 +1558,10 @@ namespace Microsoft.FSharp.Core /// The F# function. static member inline ToFSharpFunc : action:Action<'T> -> ('T -> unit) -#if !FX_NO_CONVERTER /// Convert the given Converter delegate object to an F# function value /// The input Converter delegate. /// The F# function. static member inline ToFSharpFunc : converter:Converter<'T,'U> -> ('T -> 'U) -#endif /// Convert the given Action delegate object to an F# function value /// The input Action delegate. @@ -2360,10 +2341,9 @@ namespace Microsoft.FSharp.Core [] val nanf: float32 -#if !FX_NO_SYSTEM_CONSOLE /// Reads the value of the property System.Console.In. [] - val stdin<'T> : System.IO.TextReader + val stdin<'T> : System.IO.TextReader /// Reads the value of the property System.Console.Error. [] @@ -2372,7 +2352,6 @@ namespace Microsoft.FSharp.Core /// Reads the value of the property System.Console.Out. [] val stdout<'T> : System.IO.TextWriter -#endif /// The standard overloaded range operator, e.g. [n..m] for lists, seq {n..m} for sequences /// The start value of the range. @@ -2420,6 +2399,10 @@ namespace Microsoft.FSharp.Core [] val inline typeof<'T> : System.Type + /// Returns the name of the given symbol. + [] + val inline nameof : 'T -> string + /// An internal, library-only compiler intrinsic for compile-time /// generation of a RuntimeMethodHandle. [] diff --git a/src/fsharp/FSharp.Core/printf.fs b/src/fsharp/FSharp.Core/printf.fs index 141c9752da..26276c5fd6 100644 --- a/src/fsharp/FSharp.Core/printf.fs +++ b/src/fsharp/FSharp.Core/printf.fs @@ -47,11 +47,6 @@ module internal PrintfImpl = open Microsoft.FSharp.Collections open LanguagePrimitives.IntrinsicOperators -#if FX_RESHAPED_REFLECTION - open Microsoft.FSharp.Core.PrimReflectionAdapters - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - open System.IO [] @@ -1070,12 +1065,8 @@ module internal PrintfImpl = static member GenericToString<'T>(spec: FormatSpecifier) = let bindingFlags = -#if FX_RESHAPED_REFLECTION - isPlusForPositives spec.Flags // true - show non-public -#else if isPlusForPositives spec.Flags then BindingFlags.Public ||| BindingFlags.NonPublic else BindingFlags.Public -#endif let useZeroWidth = isPadWithZeros spec.Flags let opts = @@ -1645,20 +1636,6 @@ module Printf = [] let failwithf format = ksprintf failwith format -#if !FX_NO_SYSTEM_CONSOLE -#if EXTRAS_FOR_SILVERLIGHT_COMPILER - [] - let printf format = fprintf (!outWriter) format - - [] - let eprintf format = fprintf (!errorWriter) format - - [] - let printfn format = fprintfn (!outWriter) format - - [] - let eprintfn format = fprintfn (!errorWriter) format -#else [] let printf format = fprintf Console.Out format @@ -1670,5 +1647,3 @@ module Printf = [] let eprintfn format = fprintfn Console.Error format -#endif -#endif diff --git a/src/fsharp/FSharp.Core/printf.fsi b/src/fsharp/FSharp.Core/printf.fsi index c8f7b2dcae..10e17ec68d 100644 --- a/src/fsharp/FSharp.Core/printf.fsi +++ b/src/fsharp/FSharp.Core/printf.fsi @@ -183,7 +183,6 @@ module Printf = [] val fprintfn : textWriter:TextWriter -> format:TextWriterFormat<'T> -> 'T -#if !FX_NO_SYSTEM_CONSOLE /// Formatted printing to stderr /// The input formatter. /// The return type and arguments of the formatter. @@ -207,7 +206,7 @@ module Printf = /// The return type and arguments of the formatter. [] val printfn : format:TextWriterFormat<'T> -> 'T -#endif + /// Print to a string via an internal string buffer and return /// the result as a string. Helper printers must return strings. /// The input formatter. diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index efd9763e1c..974e32c767 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -20,11 +20,6 @@ open Microsoft.FSharp.Text.StructuredPrintfImpl.TaggedTextOps #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation -#if FX_RESHAPED_REFLECTION -open PrimReflectionAdapters -open ReflectionAdapters -#endif - //-------------------------------------------------------------------------- // RAW quotations - basic data types //-------------------------------------------------------------------------- @@ -56,11 +51,7 @@ module Helpers = let staticBindingFlags = BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly let staticOrInstanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly -#if FX_RESHAPED_REFLECTION - let publicOrPrivateBindingFlags = true -#else let publicOrPrivateBindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic -#endif let isDelegateType (typ:Type) = if typ.IsSubclassOf(typeof) then @@ -989,11 +980,7 @@ module Patterns = let resT = instFormal tyargTs rty let methInfo = try -#if FX_RESHAPED_REFLECTION - match parentT.GetMethod(nm, argTs) with -#else match parentT.GetMethod(nm, staticOrInstanceBindingFlags, null, argTs, null) with -#endif | null -> None | res -> Some res with :? AmbiguousMatchException -> None @@ -1021,11 +1008,7 @@ module Patterns = let tyArgs = List.toArray tyArgs let methInfo = try -#if FX_RESHAPED_REFLECTION - match ty.GetMethod(nm, argTypes) with -#else match ty.GetMethod(nm, staticOrInstanceBindingFlags, null, argTypes, null) with -#endif | null -> None | res -> Some res with :? AmbiguousMatchException -> None @@ -1138,21 +1121,13 @@ module Patterns = | _ -> null | ctor -> ctor - let bindProp (tc, propName, retType, argTypes, tyargs) = // We search in the instantiated type, rather than searching the generic type. let typ = mkNamedType (tc, tyargs) let argtyps : Type list = argTypes |> inst tyargs let retType : Type = retType |> inst tyargs |> removeVoid -#if FX_RESHAPED_REFLECTION - try - 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", 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", 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", String.Format(SR.GetString(SR.QfailedToBindField), fldName)) // fxcop may not see "fldName" as an arg @@ -1163,26 +1138,12 @@ module Patterns = let bindGenericCtor (tc:Type, argTypes:Instantiable) = let argtyps = instFormal (getGenericArguments tc) argTypes -#if FX_RESHAPED_REFLECTION - let argTypes = Array.ofList argtyps - tc.GetConstructor argTypes - |> bindCtorBySearchIfCandidateIsNull tc argTypes - |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) -#else tc.GetConstructor(instanceBindingFlags, null, Array.ofList argtyps, null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) -#endif let bindCtor (tc, argTypes:Instantiable, tyargs) = let typ = mkNamedType (tc, tyargs) let argtyps = argTypes |> inst tyargs -#if FX_RESHAPED_REFLECTION - let argTypes = Array.ofList argtyps - typ.GetConstructor argTypes - |> bindCtorBySearchIfCandidateIsNull typ argTypes - |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) -#else typ.GetConstructor(instanceBindingFlags, null, Array.ofList argtyps, null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) -#endif let chop n xs = if n < 0 then invalidArg "n" (SR.GetString(SR.inputMustBeNonNegative)) @@ -1358,11 +1319,7 @@ module Patterns = if a = "" then mscorlib elif a = "." then st.localAssembly else -#if FX_RESHAPED_REFLECTION - match System.Reflection.Assembly.Load(AssemblyName a) with -#else match System.Reflection.Assembly.Load a with -#endif | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) | assembly -> assembly @@ -1684,14 +1641,6 @@ module Patterns = let decodedTopResources = new Dictionary(10, HashIdentity.Structural) -#if FX_NO_REFLECTION_MODULE_HANDLES // not available on Silverlight - [] - type ModuleHandle = ModuleHandle of string * string - type System.Reflection.Module with - member x.ModuleHandle = ModuleHandle(x.Assembly.FullName, x.Name) -#else - type ModuleHandle = System.ModuleHandle -#endif [] type ReflectedDefinitionTableKey = @@ -1735,11 +1684,7 @@ module Patterns = not (decodedTopResources.ContainsKey((assem, resourceName))) then let cmaAttribForResource = -#if FX_RESHAPED_REFLECTION - CustomAttributeExtensions.GetCustomAttributes(assem, typeof) |> Seq.toArray -#else assem.GetCustomAttributes(typeof, false) -#endif |> (function null -> [| |] | x -> x) |> Array.tryPick (fun ca -> match ca with diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 2024be205b..f9e0a9daa8 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -27,11 +27,6 @@ module internal ReflectionUtils = [] module internal Impl = -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open ReflectionAdapters -#endif - let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false) let inline checkNonNull argName (v: 'T) = @@ -56,31 +51,18 @@ module internal Impl = //----------------------------------------------------------------- // GENERAL UTILITIES -#if FX_RESHAPED_REFLECTION - let instanceFieldFlags = BindingFlags.Instance - let instancePropertyFlags = BindingFlags.Instance - let staticPropertyFlags = BindingFlags.Static - let staticFieldFlags = BindingFlags.Static - let staticMethodFlags = BindingFlags.Static -#else let instanceFieldFlags = BindingFlags.GetField ||| BindingFlags.Instance let instancePropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Instance let staticPropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Static let staticFieldFlags = BindingFlags.GetField ||| BindingFlags.Static let staticMethodFlags = BindingFlags.Static -#endif - let getInstancePropertyInfo (typ: Type, propName, bindingFlags) = typ.GetProperty(propName, instancePropertyFlags ||| bindingFlags) let getInstancePropertyInfos (typ, names, bindingFlags) = names |> Array.map (fun nm -> getInstancePropertyInfo (typ, nm, bindingFlags)) - let getInstancePropertyReader (typ: Type, propName, bindingFlags) = match getInstancePropertyInfo(typ, propName, bindingFlags) with | null -> None -#if FX_RESHAPED_REFLECTION - | prop -> Some(fun (obj: obj) -> prop.GetValue (obj, null)) -#else | prop -> Some(fun (obj: obj) -> prop.GetValue (obj, instancePropertyFlags ||| bindingFlags, null, null, null)) -#endif + //----------------------------------------------------------------- // ATTRIBUTE DECOMPILATION @@ -95,7 +77,6 @@ module internal Impl = | None -> failwith "no compilation mapping attribute" | Some a -> a -#if !FX_NO_REFLECTION_ONLY let cmaName = typeof.FullName let assemblyName = typeof.Assembly.GetName().Name let _ = assert (assemblyName = "FSharp.Core") @@ -121,33 +102,26 @@ module internal Impl = match tryFindCompilationMappingAttributeFromData attrs with | None -> failwith "no compilation mapping attribute" | Some a -> a -#endif let tryFindCompilationMappingAttributeFromType (typ: Type) = -#if !FX_NO_REFLECTION_ONLY let assem = typ.Assembly if (not (isNull assem)) && assem.ReflectionOnly then tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData()) else -#endif tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof, false)) let tryFindCompilationMappingAttributeFromMemberInfo (info: MemberInfo) = -#if !FX_NO_REFLECTION_ONLY let assem = info.DeclaringType.Assembly if (not (isNull assem)) && assem.ReflectionOnly then tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData()) else -#endif tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof, false)) let findCompilationMappingAttributeFromMemberInfo (info: MemberInfo) = -#if !FX_NO_REFLECTION_ONLY let assem = info.DeclaringType.Assembly if (not (isNull assem)) && assem.ReflectionOnly then findCompilationMappingAttributeFromData (info.GetCustomAttributesData()) else -#endif findCompilationMappingAttribute (info.GetCustomAttributes (typeof, false)) let sequenceNumberOfMember (x: MemberInfo) = let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x in n @@ -285,11 +259,8 @@ module internal Impl = let getUnionCaseRecordReader (typ: Type, tag: int, bindingFlags) = let props = fieldsPropsOfUnionCase (typ, tag, bindingFlags) -#if FX_RESHAPED_REFLECTION - (fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, null))) -#else (fun (obj: obj) -> props |> Array.map (fun prop -> prop.GetValue (obj, bindingFlags, null, null, null))) -#endif + let getUnionTagReader (typ: Type, bindingFlags) : (obj -> int) = if isOptionType typ then (fun (obj: obj) -> match obj with null -> 0 | _ -> 1) @@ -302,20 +273,12 @@ module internal Impl = | Some reader -> (fun (obj: obj) -> reader obj :?> int) | None -> (fun (obj: obj) -> -#if FX_RESHAPED_REFLECTION - let m2b = typ.GetMethod("GetTag", [| typ |]) -#else let m2b = typ.GetMethod("GetTag", BindingFlags.Static ||| bindingFlags, null, [| typ |], null) -#endif m2b.Invoke(null, [|obj|]) :?> int) let getUnionTagMemberInfo (typ: Type, bindingFlags) = match getInstancePropertyInfo (typ, "Tag", bindingFlags) with -#if FX_RESHAPED_REFLECTION - | null -> (typ.GetMethod("GetTag") :> MemberInfo) -#else | null -> (typ.GetMethod("GetTag", BindingFlags.Static ||| bindingFlags) :> MemberInfo) -#endif | info -> (info :> MemberInfo) let isUnionCaseNullary (typ: Type, tag: int, bindingFlags) = @@ -335,11 +298,8 @@ module internal Impl = let getUnionCaseConstructor (typ: Type, tag: int, bindingFlags) = let meth = getUnionCaseConstructorMethod (typ, tag, bindingFlags) (fun args -> -#if FX_RESHAPED_REFLECTION - meth.Invoke(null, args)) -#else meth.Invoke(null, BindingFlags.Static ||| BindingFlags.InvokeMethod ||| bindingFlags, null, args, null)) -#endif + let checkUnionType (unionType, bindingFlags) = checkNonNull "unionType" unionType if not (isUnionType (unionType, bindingFlags)) then @@ -513,18 +473,10 @@ module internal Impl = let ctor = if typ.IsValueType then let fields = typ.GetFields (instanceFieldFlags ||| BindingFlags.Public) |> orderTupleFields -#if FX_RESHAPED_REFLECTION - typ.GetConstructor(fields |> Array.map (fun fi -> fi.FieldType)) -#else typ.GetConstructor(BindingFlags.Public ||| BindingFlags.Instance, null, fields |> Array.map (fun fi -> fi.FieldType), null) -#endif else let props = typ.GetProperties() |> orderTupleProperties -#if FX_RESHAPED_REFLECTION - typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType)) -#else typ.GetConstructor(BindingFlags.Public ||| BindingFlags.Instance, null, props |> Array.map (fun p -> p.PropertyType), null) -#endif match ctor with | null -> raise (ArgumentException (String.Format (SR.GetString (SR.invalidTupleTypeConstructorNotDefined), typ.FullName))) | _ -> () @@ -533,11 +485,7 @@ module internal Impl = let getTupleCtor(typ: Type) = let ctor = getTupleConstructorMethod typ (fun (args: obj[]) -> -#if FX_RESHAPED_REFLECTION - ctor.Invoke args) -#else ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public, null, args, null)) -#endif let rec getTupleReader (typ: Type) = let etys = typ.GetGenericArguments() @@ -639,11 +587,7 @@ module internal Impl = let getRecordConstructorMethod(typ: Type, bindingFlags) = let props = fieldPropsOfRecordType(typ, bindingFlags) -#if FX_RESHAPED_REFLECTION - let ctor = typ.GetConstructor(props |> Array.map (fun p -> p.PropertyType)) -#else let ctor = typ.GetConstructor(BindingFlags.Instance ||| bindingFlags, null, props |> Array.map (fun p -> p.PropertyType), null) -#endif match ctor with | null -> raise <| ArgumentException (String.Format (SR.GetString (SR.invalidRecordTypeConstructorNotDefined), typ.FullName)) | _ -> () @@ -652,11 +596,7 @@ module internal Impl = let getRecordConstructor(typ: Type, bindingFlags) = let ctor = getRecordConstructorMethod(typ, bindingFlags) (fun (args: obj[]) -> -#if FX_RESHAPED_REFLECTION - ctor.Invoke args) -#else ctor.Invoke(BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| bindingFlags, null, args, null)) -#endif /// EXCEPTION DECOMPILATION // Check the base type - if it is also an F# type then @@ -703,10 +643,6 @@ module internal Impl = if not (isTupleType tupleType) then invalidArg argName (String.Format (SR.GetString (SR.notATupleType), tupleType.FullName)) -#if FX_RESHAPED_REFLECTION -open ReflectionAdapters -#endif - [] type UnionCaseInfo(typ: System.Type, tag: int) = diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index ab48146b63..97326e7315 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -1071,11 +1071,7 @@ namespace Microsoft.FSharp.Collections [] let groupBy (projection:'T->'Key) (source:seq<'T>) = -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then mkDelayedSeq (fun () -> groupByValueType projection source) else mkDelayedSeq (fun () -> groupByRefType projection source) @@ -1164,11 +1160,7 @@ namespace Microsoft.FSharp.Collections let countBy (projection:'T->'Key) (source:seq<'T>) = checkNonNull "source" source -#if FX_RESHAPED_REFLECTION - if (typeof<'Key>).GetTypeInfo().IsValueType -#else if typeof<'Key>.IsValueType -#endif then mkDelayedSeq (fun () -> countByValueType projection source) else mkDelayedSeq (fun () -> countByRefType projection source) diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index f0c88dcf58..5da5152f29 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -512,23 +512,20 @@ module internal SetTree = [>)>] [] [] -type Set<[]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) = +type Set<[]'T when 'T: comparison >(comparer:IComparer<'T>, tree: SetTree<'T>) = -#if !FX_NO_BINARY_SERIALIZATION [] - // NOTE: This type is logically immutable. This field is only mutated during deserialization. - let mutable comparer = comparer + // NOTE: This type is logically immutable. This field is only mutated during deserialization. + let mutable comparer = comparer [] - // NOTE: This type is logically immutable. This field is only mutated during deserialization. - let mutable tree = tree + // NOTE: This type is logically immutable. This field is only mutated during deserialization. + let mutable tree = tree - // NOTE: This type is logically immutable. This field is only mutated during serialization and deserialization. - // - // WARNING: The compiled name of this field may never be changed because it is part of the logical + // NOTE: This type is logically immutable. This field is only mutated during serialization and deserialization. + // WARNING: The compiled name of this field may never be changed because it is part of the logical // WARNING: permanent serialization format for this type. - let mutable serializedData = null -#endif + let mutable serializedData = null // We use .NET generics per-instantiation static fields to avoid allocating a new object for each empty // set (it is just a lookup into a .NET table of type-instantiation-indexed static fields). @@ -537,7 +534,6 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T let comparer = LanguagePrimitives.FastGenericComparer<'T> Set<'T>(comparer, SetEmpty) -#if !FX_NO_BINARY_SERIALIZATION [] member __.OnSerializing(context: System.Runtime.Serialization.StreamingContext) = ignore context @@ -554,7 +550,6 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T comparer <- LanguagePrimitives.FastGenericComparer<'T> tree <- SetTree.ofArray comparer serializedData serializedData <- null -#endif [] member internal set.Comparer = comparer diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.cs.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.cs.xlf index 7c8e97d650..c1837555d3 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.cs.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.cs.xlf @@ -707,6 +707,11 @@ Toto není platný výraz dotazu. V dotazu byla použita konstrukce {0}, která není rozpoznána překladačem dotazu z jazyka F# do jazyka LINQ. Prostudujte si specifikace povolených dotazů a zvažte přesunutí některých operací mimo výraz dotazu. + + maxDegreeOfParallelism must be positive, was {0} + Hodnota maxDegreeOfParallelism musí být kladná, ale vyskytla se hodnota {0}. + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.de.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.de.xlf index cfcd71290f..bb113a5dd4 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.de.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.de.xlf @@ -707,6 +707,11 @@ Dies ist kein gültiger Abfrageausdruck. Das Konstrukt "{0}" wurde in einer Abfrage verwendet, wird jedoch vom F#-to-LINQ-Abfragekonvertierungsprogramm nicht erkannt. Überprüfen Sie die Spezifikation zulässiger Abfragen, und entfernen Sie unter Umständen einige Operationen aus dem Abfrageausdruck. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism muss positiv sein, lautete jedoch "{0}". + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.es.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.es.xlf index 46a617777f..da7f891936 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.es.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.es.xlf @@ -707,6 +707,11 @@ Esta no es una expresión de consulta válida. La construcción '{0}' se usó en una consulta, pero el traductor de consultas F#-to-LINQ no la reconoce. Compruebe la especificación de consultas permitidas y considere mover algunas de las operaciones fuera de la expresión de consulta. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism debe ser positivo, era {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.fr.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.fr.xlf index 09dfb48a62..7dc0ce7839 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.fr.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.fr.xlf @@ -707,6 +707,11 @@ Cette expression de requête n'est pas valide. La construction '{0}' a été utilisée dans une requête, mais n'est pas reconnue par le traducteur de requête F#-to-LINQ. Vérifiez la spécification des requêtes autorisées et envisagez de retirer certaines opérations de l'expression de requête. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism doit être positif, était {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.it.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.it.xlf index 5598638a5f..170e1e51a8 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.it.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.it.xlf @@ -707,6 +707,11 @@ Espressione di query non valida. Il costrutto '{0}' è stato utilizzato in una query ma non è stato riconosciuto dal traduttore di query da F# a LINQ. Verificare le specifiche delle query consentite e provare a spostare alcune operazioni all'esterno dell'espressione di query. + + maxDegreeOfParallelism must be positive, was {0} + Il valore di maxDegreeOfParallelism deve essere positivo. È {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.ja.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.ja.xlf index d33e013cb6..23b3da2999 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.ja.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.ja.xlf @@ -707,6 +707,11 @@ これは有効なクエリ式ではありません。クエリで構造 '{0}' が使用されていますが、F# から LINQ へのクエリ トランスレーターに認識されません。許可されたクエリの仕様を確認し、一部の操作をクエリ式の外に移動することを検討してください。 + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism には正の値を指定する必要がありますが、{0} が指定されました + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.ko.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.ko.xlf index ed24759baa..0b5c94149a 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.ko.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.ko.xlf @@ -707,6 +707,11 @@ 올바른 쿼리 식이 아닙니다. '{0}' 구문이 쿼리에 사용되었지만 F#-to-LINQ 쿼리 변환기에서 인식할 수 없습니다. 허용되는 쿼리의 사양을 확인하고 일부 연산을 쿼리 식 외부로 이동하세요. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism은 양수여야 하는데 {0}였습니다. + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.pl.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.pl.xlf index 3d869bc263..2fdde8861c 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.pl.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.pl.xlf @@ -707,6 +707,11 @@ To nie jest prawidłowe wyrażenie zapytania. Konstrukcja „{0}” została użyta w zapytaniu, ale nie rozpoznaje jej translator zapytań z języka F# na język LINQ. Sprawdź specyfikacje dozwolonych zapytań i rozważ przeniesienie niektórych operacji poza wyrażenie zapytania. + + maxDegreeOfParallelism must be positive, was {0} + Wartość maxDegreeOfParallelism musi być dodatnia, a była równa {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.pt-BR.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.pt-BR.xlf index 48c0450f62..78d9107a47 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.pt-BR.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.pt-BR.xlf @@ -707,6 +707,11 @@ Expressão de consulta inválida. A construção '{0}' foi usada em uma consulta, mas não é reconhecida pelo conversor de consultas F#-to-LINQ. Verifique a especificação de consultas permitidas e considere remover algumas das operações da expressão de consulta. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism deve ser positivo, foi {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.ru.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.ru.xlf index cb488ded3e..c45569be95 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.ru.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.ru.xlf @@ -707,6 +707,11 @@ Недопустимое выражение запроса. Конструкция "{0}" использовалась запросе, но не была распознана транслятором запросов из F# в LINQ. Проверьте спецификацию разрешенных запросов и попробуйте вынести часть операций за пределы выражения запроса. + + maxDegreeOfParallelism must be positive, was {0} + Параметр maxDegreeOfParallelism должен иметь положительное значение, указано значение {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.tr.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.tr.xlf index 2baf7f4b07..f168225ae6 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.tr.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.tr.xlf @@ -707,6 +707,11 @@ Bu geçerli bir sorgu ifadesi değil. '{0}' yapısı sorguda kullanıldı, ancak F#-to-LINQ çevirmeni tarafından tanınmıyor. İzin verilen soruların belirtimini denetleyin ve işlemlerden bazılarını sorgu ifadesinin dışına taşımayı düşünün. + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism pozitif olmalıdır, değeri: {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hans.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hans.xlf index 9bac5ce1a8..4995ea3408 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hans.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hans.xlf @@ -707,6 +707,11 @@ 这不是有效的查询表达式。查询中使用了构造“{0}”，但 F#-LINQ 查询转换器无法识别该构造。请查看有效查询的规范，考虑是否将部分运算移到查询表达式之外。 + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism 必须是正数，它之前是 {0} + + \ No newline at end of file diff --git a/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hant.xlf b/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hant.xlf index e75ede8758..e89c723874 100644 --- a/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hant.xlf +++ b/src/fsharp/FSharp.Core/xlf/FSCore.zh-Hant.xlf @@ -564,7 +564,7 @@ Bad integer supplied to dynamic formatter - 提供給動態格式子的整數錯誤 + 提供給動態格式器的整數錯誤 @@ -707,6 +707,11 @@ 這不是有效的查詢運算式。查詢中使用了建構 '{0}'，但 F#-to-LINQ 查詢翻譯工具無法加以辨認。請檢查所允許之查詢的規格，並考慮將一些運算移出查詢運算式。 + + maxDegreeOfParallelism must be positive, was {0} + maxDegreeOfParallelism 必須為正數，原先為 {0} + + \ No newline at end of file diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 5e61742fd9..62300df676 100755 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7444,13 +7444,10 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = mkLdarg 2us mkNormalCall (mkILCtorMethSpecForTy (g.iltyp_Exception, [serializationInfoType; streamingContextType])) ], None)) - -//#if BE_SECURITY_TRANSPARENT + [ilCtorDefForSerialziation] -//#else (* let getObjectDataMethodForSerialization = - let ilMethodDef = mkILNonGenericVirtualMethod ("GetObjectData", ILMemberAccess.Public, @@ -7478,7 +7475,7 @@ and GenExnDef cenv mgbuf eenv m (exnc: Tycon) = | _ -> [] let ilTypeName = tref.Name - + let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) let tdef = mkILGenericClass diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs new file mode 100644 index 0000000000..4f55325311 --- /dev/null +++ b/src/fsharp/LanguageFeatures.fs @@ -0,0 +1,98 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc. +module internal FSharp.Compiler.Features + +open System + +//------------------------------------------------------------------------------------------------------------------ +// Language version command line switch +//------------------------------------------------------------------------------------------------------------------ +// Add your features to this List - in code use languageVersion.SupportsFeature(LanguageFeatures.yourFeature) +// a return value of false means your feature is not supported by the user's language selection +// All new language features added from now on must be protected by this. +// Note: +// * The fslang design process will require a decision about feature name and whether it is required. +// * When a feature is assigned a release language, we will scrub the code of feature references and apply +// the Release Language version. + +/// LanguageFeature enumeration +[] +type LanguageFeature = + | PreviewVersion = 0 + | LanguageVersion46 = 1 + | LanguageVersion47 = 2 + | SingleUnderscorePattern = 3 + | WildCardInForLoop = 4 + | RelaxWhitespace = 5 + | NameOf = 6 + | ImplicitYield = 7 + | OpenStaticClasses = 8 + + +/// LanguageVersion management +type LanguageVersion (specifiedVersion) = + + // When we increment language versions here preview is higher than current RTM version + static let languageVersion46 = 4.6m + static let languageVersion47 = 4.7m + static let previewVersion = 9999m // Language version when preview specified + static let defaultVersion = languageVersion47 // Language version when default specified + static let latestVersion = defaultVersion // Language version when latest specified + static let latestMajorVersion = languageVersion46 // Language version when latestmajor specified + + static let validOptions = [| "preview"; "default"; "latest"; "latestmajor" |] + static let languageVersions = set [| languageVersion46; languageVersion47 |] + + static let features = dict [| + // Add new LanguageVersions here ... + LanguageFeature.LanguageVersion46, languageVersion46 + LanguageFeature.LanguageVersion47, languageVersion47 + LanguageFeature.PreviewVersion, previewVersion + LanguageFeature.SingleUnderscorePattern, languageVersion47 + LanguageFeature.WildCardInForLoop, languageVersion47 + LanguageFeature.RelaxWhitespace, languageVersion47 + LanguageFeature.NameOf, previewVersion + LanguageFeature.ImplicitYield, languageVersion47 + LanguageFeature.OpenStaticClasses, previewVersion + |] + + let specified = + match specifiedVersion with + | "?" -> 0m + | "preview" -> previewVersion + | "default" -> latestVersion + | "latest" -> latestVersion + | "latestmajor" -> latestMajorVersion + | _ -> + match Decimal.TryParse(specifiedVersion) with + | true, v -> v + | _ -> 0m + + /// Check if this feature is supported by the selected langversion + member __.SupportsFeature featureId = + match features.TryGetValue featureId with + | true, v -> v <= specified + | false, _ -> false + + /// Does the languageVersion support this version string + member __.ContainsVersion version = + match version with + | "?" | "preview" | "default" | "latest" | "latestmajor" -> true + | _ -> + match Decimal.TryParse(specifiedVersion) with + | true, v -> languageVersions.Contains v + | _ -> false + + /// Get a list of valid strings for help text + member __.ValidOptions = validOptions + + /// Get a list of valid versions for help text + member __.ValidVersions = [| + for v in languageVersions |> Seq.sort do + let label = if v = defaultVersion then " (Default)" else "" + yield sprintf "%M%s" v label + |] + + /// Get the specified LanguageVersion + member __.SpecifiedVerson = specified diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi new file mode 100644 index 0000000000..d1d190d3f9 --- /dev/null +++ b/src/fsharp/LanguageFeatures.fsi @@ -0,0 +1,39 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc. +module internal FSharp.Compiler.Features + +/// LanguageFeature enumeration +[] +type LanguageFeature = + | PreviewVersion = 0 + | LanguageVersion46 = 1 + | LanguageVersion47 = 2 + | SingleUnderscorePattern = 3 + | WildCardInForLoop = 4 + | RelaxWhitespace = 5 + | NameOf = 6 + | ImplicitYield = 7 + | OpenStaticClasses = 8 + + +/// LanguageVersion management +type LanguageVersion = + + /// Create a LanguageVersion management object + new: string -> LanguageVersion + + /// Get the list of valid versions + member ContainsVersion: string -> bool + + /// Does the specified LanguageVersion support the specified feature + member SupportsFeature: LanguageFeature -> bool + + /// Get the list of valid versions + member ValidVersions: string array + + /// Get the list of valid options + member ValidOptions: string array + + /// Get the specified LanguageVersion + member SpecifiedVerson: decimal diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 7cfdbcf494..e37b0c35b1 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -12,9 +12,9 @@ open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Parser open FSharp.Compiler.Lexhelp - let debug = false let stringOfPos (p: Position) = sprintf "(%d:%d)" p.OriginalLine p.Column @@ -764,8 +764,17 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // 'type C = class ... ' limited by 'type' // 'type C = interface ... ' limited by 'type' // 'type C = struct ... ' limited by 'type' - | _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) - -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) + | _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) + + // 'type C(' limited by 'type' + | _, (CtxtSeqBlock _ :: CtxtParen(LPAREN, _) :: (CtxtTypeDefns _ as limitCtxt) :: _ ) + // 'static member C(' limited by 'static', likewise others + | _, (CtxtSeqBlock _ :: CtxtParen(LPAREN, _) :: (CtxtMemberHead _ as limitCtxt) :: _ ) + // 'static member P with get() = ' limited by 'static', likewise others + | _, (CtxtWithAsLet _ :: (CtxtMemberHead _ as limitCtxt) :: _ ) + when lexbuf.SupportsFeature LanguageFeature.RelaxWhitespace + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // REVIEW: document these | _, (CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) @@ -780,6 +789,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // else expr | (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) + // Permitted inner-construct precise block alignment: // while ... // do expr diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 895f2d1f72..cf590b69ee 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -938,6 +938,19 @@ let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m objArgs f = let hasCallInfo = ccallInfo.IsSome let mustTakeAddress = hasCallInfo || minfo.ObjArgNeedsAddress(amap, m) let objArgTy = tyOfExpr g objArgExpr + + let isMutable = + match isMutable with + | DefinitelyMutates + | NeverMutates + | AddressOfOp -> isMutable + | PossiblyMutates -> + // Check to see if the method is read-only. Perf optimization. + // If there is an extension member whose first arg is an inref, we must return NeverMutates. + if mustTakeAddress && (minfo.IsReadOnly || minfo.IsReadOnlyExtensionMember (amap, m)) then + NeverMutates + else + isMutable let wrap, objArgExprAddr, isReadOnly, _isWriteOnly = mkExprAddrOfExpr g mustTakeAddress hasCallInfo isMutable objArgExpr None m diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 6f03bbc1d4..9715905d3c 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -24,6 +24,7 @@ open FSharp.Compiler.AttributeChecking open FSharp.Compiler.InfoReader open FSharp.Compiler.PrettyNaming open FSharp.Compiler.Text +open FSharp.Compiler.Features open System.Collections.Generic #if !NO_EXTENSIONTYPING @@ -35,6 +36,7 @@ type NameResolver(g: TcGlobals, amap: Import.ImportMap, infoReader: InfoReader, instantiationGenerator: (range -> Typars -> TypeInst)) = + /// Used to transform typars into new inference typars // instantiationGenerator is a function to help us create the // type parameters by copying them from type parameter specifications read @@ -49,6 +51,7 @@ type NameResolver(g: TcGlobals, member nr.g = g member nr.amap = amap member nr.InfoReader = infoReader + member nr.languageSupportsNameOf = g.langVersion.SupportsFeature LanguageFeature.NameOf //------------------------------------------------------------------------- // Helpers for unionconstrs and recdfields @@ -78,7 +81,6 @@ let ActivePatternElemsOfValRef vref = | Some apinfo -> apinfo.ActiveTags |> List.mapi (fun i _ -> APElemRef(apinfo, vref, i)) | None -> [] - /// Try to make a reference to a value in a module. // // mkNestedValRef may fail if the assembly load set is @@ -314,6 +316,7 @@ type FullyQualifiedFlag = | OpenQualified +type UnqualifiedItems = LayeredMap [] /// The environment of information used to resolve names @@ -321,8 +324,8 @@ type NameResolutionEnv = { /// Display environment information for output eDisplayEnv: DisplayEnv - /// Values and Data Tags available by unqualified name - eUnqualifiedItems: LayeredMap + /// Values, functions, methods and other items available by unqualified name + eUnqualifiedItems: UnqualifiedItems /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap @@ -417,6 +420,12 @@ type NameResolutionEnv = // Helpers to do with extension members //------------------------------------------------------------------------- +/// Indicates if we only need one result or all possible results from a resolution. +[] +type ResultCollectionSettings = + | AllResults + | AtMostOneResult + /// Allocate the next extension method priority. This is an incrementing sequence of integers /// during type checking. let NextExtensionMethodPriority() = uint64 (newStamp()) @@ -488,6 +497,125 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap: Import.Impor [] +/// Query the declared properties of a type (including inherited properties) +let IntrinsicPropInfosOfTypeInScope (infoReader: InfoReader) optFilter ad findFlag m ty = + let g = infoReader.g + let amap = infoReader.amap + let pinfos = GetIntrinsicPropInfoSetsOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty + let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m + pinfos + +/// Select from a list of extension properties +let SelectPropInfosFromExtMembers (infoReader: InfoReader) ad optFilter declaringTy m extMemInfos = + let g = infoReader.g + let amap = infoReader.amap + // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers, hence use a set. + let seen = HashSet(ExtensionMember.Comparer g) + let propCollector = new PropertyCollector(g, amap, m, declaringTy, optFilter, ad) + for emem in extMemInfos do + if seen.Add emem then + match emem with + | FSExtMem (vref, _pri) -> + match vref.MemberInfo with + | None -> () + | Some membInfo -> propCollector.Collect(membInfo, vref) + | ILExtMem _ -> + // No extension properties coming from .NET + () + propCollector.Close() + +/// Query the available extension properties of a type (including extension properties for inherited types) +let ExtensionPropInfosOfTypeInScope collectionSettings (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter ad m ty = + let g = infoReader.g + + let extMemsDangling = SelectPropInfosFromExtMembers infoReader ad optFilter ty m nenv.eUnindexedExtensionMembers + + if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then + extMemsDangling + else + let extMemsFromHierarchy = + infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty) + |> List.collect (fun ty -> + if isAppTy g ty then + let tcref = tcrefOfAppTy g ty + let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref + SelectPropInfosFromExtMembers infoReader ad optFilter ty m extMemInfos + else []) + + extMemsDangling @ extMemsFromHierarchy + +/// Get all the available properties of a type (both intrinsic and extension) +let AllPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty = + IntrinsicPropInfosOfTypeInScope infoReader optFilter ad findFlag m ty + @ ExtensionPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad m ty + +/// Get the available methods of a type (both declared and inherited) +let IntrinsicMethInfosOfType (infoReader:InfoReader) optFilter ad allowMultiIntfInst findFlag m ty = + let g = infoReader.g + let amap = infoReader.amap + let minfos = GetIntrinsicMethInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty + let minfos = minfos |> ExcludeHiddenOfMethInfos g amap m + minfos + +/// Select from a list of extension methods +let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m extMemInfos = + let g = infoReader.g + // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers + let seen = HashSet(ExtensionMember.Comparer g) + [ + for emem in extMemInfos do + if seen.Add emem then + match emem with + | FSExtMem (vref, pri) -> + match vref.MemberInfo with + | None -> () + | Some membInfo -> + match TrySelectMemberVal g optFilter apparentTy (Some pri) membInfo vref with + | Some m -> yield m + | _ -> () + | ILExtMem (actualParent, minfo, pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) -> + // Make a reference to the type containing the extension members + match minfo with + | ILMeth(_, ilminfo, _) -> + yield (MethInfo.CreateILExtensionMeth (infoReader.amap, m, apparentTy, actualParent, Some pri, ilminfo.RawMetadata)) + // F#-defined IL-style extension methods are not seen as extension methods in F# code + | FSMeth(g, _, vref, _) -> + yield (FSMeth(g, apparentTy, vref, Some pri)) +#if !NO_EXTENSIONTYPING + // // Provided extension methods are not yet supported + | ProvidedMeth(amap, providedMeth, _, m) -> + yield (ProvidedMeth(amap, providedMeth, Some pri, m)) +#endif + | DefaultStructCtor _ -> + () + | _ -> () + ] + +/// Query the available extension properties of a methods (including extension methods for inherited types) +let ExtensionMethInfosOfTypeInScope (collectionSettings:ResultCollectionSettings) (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m ty = + let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers + if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then + extMemsDangling + else + let extMemsFromHierarchy = + infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty) + |> List.collect (fun ty -> + let g = infoReader.g + if isAppTy g ty then + let tcref = tcrefOfAppTy g ty + let extValRefs = nenv.eIndexedExtensionMembers.Find tcref + SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs + else []) + extMemsDangling @ extMemsFromHierarchy + +/// Get all the available methods of a type (both intrinsic and extension) +let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty = + let intrinsic = IntrinsicMethInfosOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty + if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil intrinsic) then + intrinsic + else + intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter m ty + //------------------------------------------------------------------------- // Helpers to do with building environments //------------------------------------------------------------------------- @@ -504,7 +632,7 @@ type BulkAdd = Yes | No /// bulkAddMode: true when adding the values from the 'open' of a namespace /// or module, when we collapse the value table down to a dictionary. -let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: LayeredMap<_, _>) (vrefs: ValRef[]) = +let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: UnqualifiedItems) (vrefs: ValRef[]) = // Object model members are not added to the unqualified name resolution environment let vrefs = vrefs |> Array.filter (fun vref -> not vref.IsMember) @@ -616,7 +744,7 @@ let AddUnionCases1 (tab: Map<_, _>) (ucrefs: UnionCaseRef list) = acc.Add (ucref.CaseName, item)) /// Add a set of union cases to the corresponding sub-table of the environment -let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_, _>) (ucrefs: UnionCaseRef list) = +let AddUnionCases2 bulkAddMode (eUnqualifiedItems: UnqualifiedItems) (ucrefs: UnionCaseRef list) = match bulkAddMode with | BulkAdd.Yes -> let items = @@ -630,8 +758,46 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_, _>) (ucrefs: Un let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) +let AddStaticContentOfTyconRefToNameEnv (g:TcGlobals) (amap: Import.ImportMap) ad m (nenv: NameResolutionEnv) (tcref:TyconRef) = + // If OpenStaticClasses is not enabled then don't do this + if amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses then + let ty = generalizedTyconRef tcref + let infoReader = InfoReader(g,amap) + let items = + [| let methGroups = + AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty + |> List.groupBy (fun m -> m.LogicalName) + + for (methName, methGroup) in methGroups do + let methGroup = methGroup |> List.filter (fun m -> not m.IsInstance && not m.IsClassConstructor) + if not methGroup.IsEmpty then + yield KeyValuePair(methName, Item.MethodGroup(methName, methGroup, None)) + + let propInfos = + AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults infoReader nenv None ad PreferOverrides m ty + |> List.groupBy (fun m -> m.PropertyName) + + for (propName, propInfos) in propInfos do + let propInfos = propInfos |> List.filter (fun m -> m.IsStatic) + for propInfo in propInfos do + yield KeyValuePair(propName , Item.Property(propName,[propInfo])) + + let fields = + infoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> List.groupBy (fun f -> f.FieldName) + + for (fieldName, fieldInfos) in fields do + let fieldInfos = fieldInfos |> List.filter (fun fi -> fi.IsStatic) + for fieldInfo in fieldInfos do + yield KeyValuePair(fieldName, Item.ILField(fieldInfo)) + |] + + { nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.AddAndMarkAsCollapsible items } + else + nenv + /// Add any implied contents of a type definition to the environment. -let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap m nenv (tcref: TyconRef) = +let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) amap ad m nenv (tcref: TyconRef) = let isIL = tcref.IsILTycon let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef @@ -679,10 +845,14 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) | _ -> Item.UnqualifiedType [tcref])) else tab - if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then - tab - else - AddUnionCases2 bulkAddMode tab ucrefs + + let tab = + if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then + tab + else + AddUnionCases2 bulkAddMode tab ucrefs + + tab let ePatItems = if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then @@ -690,17 +860,26 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g: TcGlobals) else AddUnionCases1 nenv.ePatItems ucrefs - { nenv with - eFieldLabels = eFieldLabels - eUnqualifiedItems = eUnqualifiedItems - ePatItems = ePatItems - eIndexedExtensionMembers = eIndexedExtensionMembers - eUnindexedExtensionMembers = eUnindexedExtensionMembers } + let nenv = + { nenv with + eFieldLabels = eFieldLabels + eUnqualifiedItems = eUnqualifiedItems + ePatItems = ePatItems + eIndexedExtensionMembers = eIndexedExtensionMembers + eUnindexedExtensionMembers = eUnindexedExtensionMembers } + + let nenv = + if TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && isStaticClass g tcref then + AddStaticContentOfTyconRefToNameEnv g amap ad m nenv tcref + else + nenv + + nenv /// Add a set of type definitions to the name resolution environment -let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m root nenv tcrefs = +let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs = if isNil tcrefs then nenv else - let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m) nenv tcrefs + let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap ad m) nenv tcrefs // Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace let tcrefs = Array.ofList tcrefs { env with @@ -799,7 +978,7 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai let tcref = modref.NestedTyconRef tycon if IsEntityAccessible amap m ad tcref then Some tcref else None) - let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false + let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap ad m false let vrefs = mty.AllValsAndMembers.ToList() |> List.choose (fun x -> if IsAccessible ad x.Accessibility then TryMkValRefInModRef modref x else None) @@ -817,8 +996,14 @@ and AddModuleOrNamespaceContentsToNameEnv (g: TcGlobals) amap (ad: AccessorDomai // open M1 // // The list contains [M1b; M1a] -and AddModulesAndNamespacesContentsToNameEnv g amap ad m root nenv modrefs = - (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddModuleOrNamespaceContentsToNameEnv g amap ad m root acc modref) +and AddEntitiesContentsToNameEnv g amap ad m root nenv modrefs = + (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddEntityContentsToNameEnv g amap ad m root acc modref) + +and AddEntityContentsToNameEnv g amap ad m root nenv (modref: EntityRef) = + if modref.IsModuleOrNamespace then + AddModuleOrNamespaceContentsToNameEnv g amap ad m root nenv modref + else + AddStaticContentOfTyconRefToNameEnv g amap ad m nenv modref /// Add a single modules or namespace to the name resolution environment let AddModuleOrNamespaceRefToNameEnv g amap m root ad nenv (modref: EntityRef) = @@ -910,18 +1095,13 @@ let AddResults res1 res2 = let NoResultsOrUsefulErrors = Result [] -/// Indicates if we only need one result or all possible results from a resolution. -[] -type ResultCollectionSettings = -| AllResults -| AtMostOneResult - let rec CollectResults f = function | [] -> NoResultsOrUsefulErrors | [h] -> OneResult (f h) | h :: t -> AddResults (OneResult (f h)) (CollectResults f t) -let rec CollectAtMostOneResult f = function +let rec CollectAtMostOneResult f inputs = + match inputs with | [] -> NoResultsOrUsefulErrors | [h] -> OneResult (f h) | h :: t -> @@ -1257,7 +1437,7 @@ type FormatStringCheckContext = type ITypecheckResultsSink = abstract NotifyEnvWithScope: range * NameResolutionEnv * AccessorDomain -> unit abstract NotifyExprHasType: pos * TType * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit - abstract NotifyNameResolution: pos * Item * Item * TyparInst * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * bool -> unit + abstract NotifyNameResolution: pos * item: Item * itemMethodGroup: Item * TyparInst * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * replace: bool -> unit abstract NotifyFormatSpecifierLocation: range * int -> unit abstract NotifyOpenDeclaration: OpenDeclaration -> unit abstract CurrentSourceText: ISourceText option @@ -1828,13 +2008,16 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities //------------------------------------------------------------------------- /// Perform name resolution for an identifier which must resolve to be a namespace or module. -let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQualified (nenv: NameResolutionEnv) ad (id: Ident) (rest: Ident list) isOpenDecl = +let rec ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m allowStaticClasses first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = + + // If the selected language version doesn't support open static classes then turn them off. + let allowStaticClasses = allowStaticClasses && amap.g.langVersion.SupportsFeature LanguageFeature.OpenStaticClasses if first && id.idText = MangledGlobalName then match rest with | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl + ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink atMostOne amap m allowStaticClasses false FullyQualified nenv ad id2 rest2 isOpenDecl else let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified let namespaceNotFound = lazy( @@ -1847,6 +2030,8 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu UndefinedName(0, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestModulesAndNamespaces)) + // Avoid generating the same error and name suggestion thunk twice It's not clear this is necessary + // since it's just saving an allocation. let mutable moduleNotFoundErrorCache = None let moduleNotFound (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (id: Ident) depth = match moduleNotFoundErrorCache with @@ -1867,35 +2052,69 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occurence, nenv.DisplayEnv, ad) - match moduleOrNamespaces.TryGetValue id.idText with - | true, modrefs -> + let erefs = + let modrefs = + match moduleOrNamespaces.TryGetValue id.idText with + | true, modrefs -> modrefs + | _ -> [] + + let tcrefs = + if allowStaticClasses then + LookupTypeNameInEnvNoArity fullyQualified id.idText nenv |> List.filter (isStaticClass amap.g) + else [] + + modrefs @ tcrefs + + if not erefs.IsEmpty then /// Look through the sub-namespaces and/or modules - let rec look depth (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (lid: Ident list) = + let rec look depth allowStaticClasses (modref: ModuleOrNamespaceRef) (lid: Ident list) = + let mty = modref.ModuleOrNamespaceType match lid with - | [] -> success (depth, modref, mty) - | id :: rest -> - match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, mspec -> - let subref = modref.NestedTyconRef mspec - if IsEntityAccessible amap m ad subref then - notifyNameResolution subref id.idRange - look (depth+1) subref mspec.ModuleOrNamespaceType rest - else - moduleNotFound modref mty id depth - | _ -> moduleNotFound modref mty id depth - + | [] -> + success [ (depth, modref, mty) ] - modrefs |> CollectResults2 atMostOne (fun modref -> - if IsEntityAccessible amap m ad modref then - notifyNameResolution modref id.idRange - look 1 modref modref.ModuleOrNamespaceType rest + | id :: rest -> + let especs = + let mspecs = + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, res -> [res] + | _ -> [] + let tspecs = + if allowStaticClasses then + LookupTypeNameInEntityNoArity id.idRange id.idText mty + |> List.filter (modref.NestedTyconRef >> isStaticClass amap.g) + else [] + mspecs @ tspecs + + if not especs.IsEmpty then + especs + |> List.map (fun espec -> + let subref = modref.NestedTyconRef espec + if IsEntityAccessible amap m ad subref then + notifyNameResolution subref id.idRange + let allowStaticClasses = allowStaticClasses && (subref.IsModuleOrNamespace || isStaticClass amap.g subref) + look (depth+1) allowStaticClasses subref rest + else + moduleNotFound modref mty id depth) + |> List.reduce AddResults + else + moduleNotFound modref mty id depth + + erefs + |> List.map (fun eref -> + if IsEntityAccessible amap m ad eref then + notifyNameResolution eref id.idRange + let allowStaticClasses = allowStaticClasses && (eref.IsModuleOrNamespace || isStaticClass amap.g eref) + look 1 allowStaticClasses eref rest else raze (namespaceNotFound.Force())) - | _ -> raze (namespaceNotFound.Force()) - + |> List.reduce AddResults + else + raze (namespaceNotFound.Force()) -let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id rest isOpenDecl f = - match ResolveLongIndentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with +// Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427) +let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass sink ResultCollectionSettings.AllResults amap m false true fullyQualified nenv ad id [] isOpenDecl with | Result modrefs -> match rest with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange)) @@ -1943,126 +2162,6 @@ let ResolveObjectConstructor (ncenv: NameResolver) edenv m ad ty = // Bind the "." notation (member lookup or lookup in a type) //------------------------------------------------------------------------- -/// Query the declared properties of a type (including inherited properties) -let IntrinsicPropInfosOfTypeInScope (infoReader:InfoReader) optFilter ad findFlag m ty = - let g = infoReader.g - let amap = infoReader.amap - let pinfos = GetIntrinsicPropInfoSetsOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty - let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m - pinfos - -/// Select from a list of extension properties -let SelectPropInfosFromExtMembers (infoReader:InfoReader) ad optFilter declaringTy m extMemInfos = - let g = infoReader.g - let amap = infoReader.amap - // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers, hence setify. - let seen = HashSet(ExtensionMember.Comparer g) - let propCollector = new PropertyCollector(g, amap, m, declaringTy, optFilter, ad) - for emem in extMemInfos do - if seen.Add emem then - match emem with - | FSExtMem (vref, _pri) -> - match vref.MemberInfo with - | None -> () - | Some membInfo -> propCollector.Collect(membInfo, vref) - | ILExtMem _ -> - // No extension properties coming from .NET - () - propCollector.Close() - -/// Query the available extension properties of a type (including extension properties for inherited types) -let ExtensionPropInfosOfTypeInScope collectionSettings (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter ad m ty = - let g = infoReader.g - - let extMemsDangling = SelectPropInfosFromExtMembers infoReader ad optFilter ty m nenv.eUnindexedExtensionMembers - - if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then - extMemsDangling - else - let extMemsFromHierarchy = - infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty) - |> List.collect (fun ty -> - if isAppTy g ty then - let tcref = tcrefOfAppTy g ty - let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref - SelectPropInfosFromExtMembers infoReader ad optFilter ty m extMemInfos - else []) - - extMemsDangling @ extMemsFromHierarchy - -/// Get all the available properties of a type (both intrinsic and extension) -let AllPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty = - IntrinsicPropInfosOfTypeInScope infoReader optFilter ad findFlag m ty - @ ExtensionPropInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad m ty - -/// Get the available methods of a type (both declared and inherited) -let IntrinsicMethInfosOfType (infoReader:InfoReader) optFilter ad allowMultiIntfInst findFlag m ty = - let g = infoReader.g - let amap = infoReader.amap - let minfos = GetIntrinsicMethInfoSetsOfType infoReader optFilter ad allowMultiIntfInst findFlag m ty - let minfos = minfos |> ExcludeHiddenOfMethInfos g amap m - minfos - -/// Select from a list of extension methods -let SelectMethInfosFromExtMembers (infoReader: InfoReader) optFilter apparentTy m extMemInfos = - let g = infoReader.g - // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers - let seen = HashSet(ExtensionMember.Comparer g) - [ - for emem in extMemInfos do - if seen.Add emem then - match emem with - | FSExtMem (vref, pri) -> - match vref.MemberInfo with - | None -> () - | Some membInfo -> - match TrySelectMemberVal g optFilter apparentTy (Some pri) membInfo vref with - | Some m -> yield m - | _ -> () - | ILExtMem (actualParent, minfo, pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) -> - // Make a reference to the type containing the extension members - match minfo with - | ILMeth(_, ilminfo, _) -> - yield (MethInfo.CreateILExtensionMeth (infoReader.amap, m, apparentTy, actualParent, Some pri, ilminfo.RawMetadata)) - // F#-defined IL-style extension methods are not seen as extension methods in F# code - | FSMeth(g, _, vref, _) -> - yield (FSMeth(g, apparentTy, vref, Some pri)) -#if !NO_EXTENSIONTYPING - // // Provided extension methods are not yet supported - | ProvidedMeth(amap, providedMeth, _, m) -> - yield (ProvidedMeth(amap, providedMeth, Some pri, m)) -#endif - | DefaultStructCtor _ -> - () - | _ -> () - ] - -/// Query the available extension properties of a methods (including extension methods for inherited types) -let ExtensionMethInfosOfTypeInScope (collectionSettings:ResultCollectionSettings) (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m ty = - let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers - if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil extMemsDangling) then - extMemsDangling - else - let extMemsFromHierarchy = - infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty) - |> List.collect (fun ty -> - let g = infoReader.g - if isAppTy g ty then - let tcref = tcrefOfAppTy g ty - let extValRefs = nenv.eIndexedExtensionMembers.Find tcref - SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs - else []) - extMemsDangling @ extMemsFromHierarchy - -/// Get all the available methods of a type (both intrinsic and extension) -let AllMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter ad findFlag m ty = - let intrinsic = IntrinsicMethInfosOfType infoReader optFilter ad AllowMultiIntfInstantiations.Yes findFlag m ty - if collectionSettings = ResultCollectionSettings.AtMostOneResult && not (isNil intrinsic) then - intrinsic - else - intrinsic @ ExtensionMethInfosOfTypeInScope collectionSettings infoReader nenv optFilter m ty - - /// Used to report an error condition where name resolution failed due to an indeterminate type exception IndeterminateType of range @@ -2410,6 +2509,15 @@ let ChooseTyconRefInExpr (ncenv: NameResolver, m, ad, nenv, id: Ident, typeNameR /// that may represent further actions, e.g. further lookups. let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified m ad nenv (typeNameResInfo: TypeNameResolutionInfo) (id: Ident) (rest: Ident list) isOpenDecl = let resInfo = ResolutionInfo.Empty + let canSuggestThisItem (item:Item) = + // All items can be suggested except nameof when it comes from FSharp.Core.dll and the nameof feature is not enabled + match item with + | Item.Value v -> + let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref v + if isNameOfOperator && not (ncenv.g.langVersion.SupportsFeature LanguageFeature.NameOf) then false + else true + | _ -> true + if first && id.idText = MangledGlobalName then match rest with | [] -> @@ -2444,7 +2552,16 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Exception e -> typeError := Some e; None | true, res -> - Some (FreshenUnqualifiedItem ncenv m res, []) + let fresh = FreshenUnqualifiedItem ncenv m res + match fresh with + | Item.Value value -> + let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref value + if isNameOfOperator && not (ncenv.languageSupportsNameOf) then + // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core + None + else + Some (fresh, []) + | _ -> Some (fresh, []) | _ -> None @@ -2475,7 +2592,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | _ -> let suggestNamesAndTypes (addToBuffer: string -> unit) = for e in nenv.eUnqualifiedItems do - addToBuffer e.Value.DisplayName + if canSuggestThisItem e.Value then + addToBuffer e.Value.DisplayName for e in nenv.TyconsByDemangledNameAndArity fullyQualified do if IsEntityAccessible ncenv.amap m ad e.Value then @@ -2571,7 +2689,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified addToBuffer e.Value.DisplayName for e in nenv.eUnqualifiedItems do - addToBuffer e.Value.DisplayName + if canSuggestThisItem e.Value then + addToBuffer e.Value.DisplayName match innerSearch with | Exception (UndefinedName(0, _, id1, suggestionsF)) when Range.equals id.idRange id1.idRange -> @@ -3970,6 +4089,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad modref rest allowObsolete else []) + // Look for values called 'id' that accept the dot-notation let values, isItemVal = (match nenv.eUnqualifiedItems.TryGetValue id with @@ -4130,6 +4250,7 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad modref rest allowObsolete else []) + let qualifiedFields = match rest with | [] -> diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 8ec9caedc7..a1567ed43b 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -22,6 +22,7 @@ type NameResolver = member InfoReader : InfoReader member amap : ImportMap member g : TcGlobals + member languageSupportsNameOf : bool /// Get the active pattern elements defined in a module, if any. Cache in the slot in the module type. val ActivePatternElemsOfModuleOrNamespace : ModuleOrNamespaceRef -> NameMap @@ -186,7 +187,7 @@ val internal AddValRefToNameEnv : NameResolutionEnv -> ValRef val internal AddActivePatternResultTagsToNameEnv : ActivePatternInfo -> NameResolutionEnv -> TType -> range -> NameResolutionEnv /// Add a list of type definitions to the name resolution environment -val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv +val internal AddTyconRefsToNameEnv : BulkAdd -> bool -> TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> TyconRef list -> NameResolutionEnv /// Add an F# exception definition to the name resolution environment val internal AddExceptionDeclsToNameEnv : BulkAdd -> NameResolutionEnv -> TyconRef -> NameResolutionEnv @@ -201,7 +202,7 @@ val internal AddModuleOrNamespaceRefsToNameEnv : TcGlobals -> val internal AddModuleOrNamespaceRefToNameEnv : TcGlobals -> ImportMap -> range -> bool -> AccessorDomain -> NameResolutionEnv -> ModuleOrNamespaceRef -> NameResolutionEnv /// Add a list of modules or namespaces to the name resolution environment -val internal AddModulesAndNamespacesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv +val internal AddEntitiesContentsToNameEnv : TcGlobals -> ImportMap -> AccessorDomain -> range -> bool -> NameResolutionEnv -> ModuleOrNamespaceRef list -> NameResolutionEnv /// A flag which indicates if it is an error to have two declared type parameters with identical names /// in the name resolution environment. @@ -468,8 +469,8 @@ type PermitDirectReferenceToGeneratedType = | Yes | No -/// Resolve a long identifier to a namespace or module. -val internal ResolveLongIndentAsModuleOrNamespace : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > +/// Resolve a long identifier to a namespace, module or static class. +val internal ResolveLongIndentAsModuleOrNamespaceOrStaticClass : TcResultsSink -> ResultCollectionSettings -> Import.ImportMap -> range -> allowStaticClasses: bool -> first: bool -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident -> Ident list -> isOpenDecl: bool -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list > /// Resolve a long identifier to an object constructor. val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index cfa1a9a49d..e89f3e4284 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1830,22 +1830,27 @@ let TryDetectQueryQuoteAndRun cenv (expr: Expr) = //printfn "Not eliminating because no Run found" None -let IsILMethodRefDeclaringTypeSystemString (ilg: ILGlobals) (mref: ILMethodRef) = - mref.DeclaringTypeRef.Scope.IsAssemblyRef && - mref.DeclaringTypeRef.Scope.AssemblyRef.Name = ilg.typ_String.TypeRef.Scope.AssemblyRef.Name && - mref.DeclaringTypeRef.BasicQualifiedName = ilg.typ_String.BasicQualifiedName - -let IsILMethodRefSystemStringConcatOverload (ilg: ILGlobals) (mref: ILMethodRef) = - IsILMethodRefDeclaringTypeSystemString ilg mref && +let IsILMethodRefSystemStringConcat (mref: ILMethodRef) = mref.Name = "Concat" && - mref.ReturnType.BasicQualifiedName = ilg.typ_String.BasicQualifiedName && - mref.ArgCount >= 2 && mref.ArgCount <= 4 && mref.ArgTypes |> List.forall(fun ilty -> ilty.BasicQualifiedName = ilg.typ_String.BasicQualifiedName) - -let IsILMethodRefSystemStringConcatArray (ilg: ILGlobals) (mref: ILMethodRef) = - IsILMethodRefDeclaringTypeSystemString ilg mref && + mref.DeclaringTypeRef.Name = "System.String" && + (mref.ReturnType.IsNominal && mref.ReturnType.TypeRef.Name = "System.String") && + (mref.ArgCount >= 2 && mref.ArgCount <= 4 && + mref.ArgTypes + |> List.forall (fun ilTy -> + ilTy.IsNominal && ilTy.TypeRef.Name = "System.String")) + +let IsILMethodRefSystemStringConcatArray (mref: ILMethodRef) = mref.Name = "Concat" && - mref.ReturnType.BasicQualifiedName = ilg.typ_String.BasicQualifiedName && - mref.ArgCount = 1 && mref.ArgTypes.Head.BasicQualifiedName = "System.String[]" + mref.DeclaringTypeRef.Name = "System.String" && + (mref.ReturnType.IsNominal && mref.ReturnType.TypeRef.Name = "System.String") && + (mref.ArgCount = 1 && + mref.ArgTypes + |> List.forall (fun ilTy -> + match ilTy with + | ILType.Array (shape, ilTy) when shape = ILArrayShape.SingleDimensional && + ilTy.IsNominal && + ilTy.TypeRef.Name = "System.String" -> true + | _ -> false)) /// Optimize/analyze an expression let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = @@ -1972,10 +1977,12 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) = and MakeOptimizedSystemStringConcatCall cenv env m args = let rec optimizeArg argExpr accArgs = match argExpr, accArgs with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsILMethodRefSystemStringConcatArray cenv.g.ilg methRef -> + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ + when IsILMethodRefSystemStringConcatArray mref -> optimizeArgs args accArgs - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, args, _), _ when IsILMethodRefSystemStringConcatOverload cenv.g.ilg mref -> + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, args, _), _ + when IsILMethodRefSystemStringConcat mref -> optimizeArgs args accArgs // Optimize string constants, e.g. "1" + "2" will turn into "12" @@ -2005,7 +2012,8 @@ and MakeOptimizedSystemStringConcatCall cenv env m args = mkStaticCall_String_Concat_Array cenv.g m arg match expr with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsILMethodRefSystemStringConcatOverload cenv.g.ilg methRef || IsILMethodRefSystemStringConcatArray cenv.g.ilg methRef -> + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _) as op, tyargs, args, m) + when IsILMethodRefSystemStringConcat mref || IsILMethodRefSystemStringConcatArray mref -> OptimizeExprOpReductions cenv env (op, tyargs, args, m) | _ -> OptimizeExpr cenv env expr @@ -2074,9 +2082,11 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) = | TOp.ILAsm ([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a // Optimize calls when concatenating strings, e.g. "1" + "2" + "3" + "4" .. etc. - | TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ] when IsILMethodRefSystemStringConcatArray cenv.g.ilg mref -> + | TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ] + when IsILMethodRefSystemStringConcatArray mref -> MakeOptimizedSystemStringConcatCall cenv env m args - | TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, args when IsILMethodRefSystemStringConcatOverload cenv.g.ilg mref -> + | TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, args + when IsILMethodRefSystemStringConcat mref -> MakeOptimizedSystemStringConcatCall cenv env m args | _ -> diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 0bf4df1c25..3b172de1e3 100755 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -528,9 +528,7 @@ let (|ConstNeedsDefaultCase|_|) c = | Const.Decimal _ | Const.String _ | Const.Single _ - | Const.Double _ - | Const.SByte _ - | Const.Byte _ + | Const.Double _ | Const.Int16 _ | Const.UInt16 _ | Const.Int32 _ @@ -1084,6 +1082,8 @@ let CompilePatternBasic match simulSetOfDiscrims with | DecisionTreeTest.Const (Const.Bool _b) :: _ when simulSetOfCases.Length = 2 -> None + | DecisionTreeTest.Const (Const.Byte _) :: _ when simulSetOfCases.Length = 256 -> None + | DecisionTreeTest.Const (Const.SByte _) :: _ when simulSetOfCases.Length = 256 -> None | DecisionTreeTest.Const (Const.Unit) :: _ -> None | DecisionTreeTest.UnionCase (ucref, _) :: _ when simulSetOfCases.Length = ucref.TyconRef.UnionCasesArray.Length -> None | DecisionTreeTest.ActivePatternCase _ :: _ -> error(InternalError("DecisionTreeTest.ActivePatternCase should have been eliminated", matchm)) diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index d6ad0cdf64..4d8f05b5a0 100755 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -282,7 +282,8 @@ let GetLimitValByRef cenv env m v = { scope = scope; flags = flags } let LimitVal cenv (v: Val) limit = - cenv.limitVals.[v.Stamp] <- limit + if not v.IgnoresByrefScope then + cenv.limitVals.[v.Stamp] <- limit let BindVal cenv env (v: Val) = //printfn "binding %s..." v.DisplayName @@ -697,6 +698,7 @@ and CheckValRef (cenv: cenv) (env: env) v m (context: PermitByRefExpr) = if isSpliceOperator cenv.g v then errorR(Error(FSComp.SR.chkNoFirstClassSplicing(), m)) if valRefEq cenv.g v cenv.g.addrof_vref then errorR(Error(FSComp.SR.chkNoFirstClassAddressOf(), m)) if valRefEq cenv.g v cenv.g.reraise_vref then errorR(Error(FSComp.SR.chkNoFirstClassRethrow(), m)) + if valRefEq cenv.g v cenv.g.nameof_vref then errorR(Error(FSComp.SR.chkNoFirstClassNameOf(), m)) // ByRefLike-typed values can only occur in permitting contexts if context.Disallow && isByrefLikeTy cenv.g m v.Type then diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index c638d9a864..91a63819da 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -22,6 +22,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.Layout open FSharp.Compiler.Layout.TaggedTextOps open FSharp.Compiler.PrettyNaming +open FSharp.Compiler.Features #if !NO_EXTENSIONTYPING open FSharp.Compiler.ExtensionTyping #endif @@ -3003,8 +3004,8 @@ let isByrefTyconRef (g: TcGlobals) (tcref: TyconRef) = let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) = tcref.CanDeref && match tcref.TryIsByRefLike with - | Some res -> res - | None -> + | ValueSome res -> res + | _ -> let res = isByrefTyconRef g tcref || (isStructTyconRef tcref && TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref) @@ -3221,6 +3222,11 @@ let isSizeOfValRef g vref = // There is an internal version of typeof defined in prim-types.fs that needs to be detected || (g.compilingFslib && vref.LogicalName = "sizeof") +let isNameOfValRef g vref = + valRefEq g vref g.nameof_vref + // There is an internal version of nameof defined in prim-types.fs that needs to be detected + || (g.compilingFslib && vref.LogicalName = "nameof") + let isTypeDefOfValRef g vref = valRefEq g vref g.typedefof_vref // There is an internal version of typedefof defined in prim-types.fs that needs to be detected @@ -3246,6 +3252,16 @@ let (|TypeDefOfExpr|_|) g expr = | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty | _ -> None +let (|NameOfExpr|_|) g expr = + match expr with + | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isNameOfValRef g vref -> Some ty + | _ -> None + +let (|SeqExpr|_|) g expr = + match expr with + | Expr.App(Expr.Val(vref,_,_),_,_,_,_) when valRefEq g vref g.seq_vref -> Some() + | _ -> None + //-------------------------------------------------------------------------- // DEBUG layout //--------------------------------------------------------------------------- @@ -5925,34 +5941,56 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets = //------------------------------------------------------------------------- type Mutates = AddressOfOp | DefinitelyMutates | PossiblyMutates | NeverMutates -exception DefensiveCopyWarning of string * range +exception DefensiveCopyWarning of string * range let isRecdOrStructTyconRefAssumedImmutable (g: TcGlobals) (tcref: TyconRef) = tcref.CanDeref && not (isRecdOrUnionOrStructTyconRefDefinitelyMutable tcref) || - tyconRefEq g tcref g.decimal_tcr || + tyconRefEq g tcref g.decimal_tcr || tyconRefEq g tcref g.date_tcr -let isRecdOrStructTyconRefReadOnly (g: TcGlobals) m (tcref: TyconRef) = +let isTyconRefReadOnly g m (tcref: TyconRef) = tcref.CanDeref && - match tcref.TryIsReadOnly with - | Some res -> res - | None -> - let isImmutable = isRecdOrStructTyconRefAssumedImmutable g tcref - let hasAttrib = TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref - let res = isImmutable || hasAttrib - tcref.SetIsReadOnly res + if + match tcref.TryIsReadOnly with + | ValueSome res -> res + | _ -> + let res = TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref + tcref.SetIsReadOnly res + res + then true + else tcref.IsEnumTycon + +let isTyconRefAssumedReadOnly g (tcref: TyconRef) = + tcref.CanDeref && + match tcref.TryIsAssumedReadOnly with + | ValueSome res -> res + | _ -> + let res = isRecdOrStructTyconRefAssumedImmutable g tcref + tcref.SetIsAssumedReadOnly res res -let isRecdOrStructTyReadOnly (g: TcGlobals) m ty = +let isRecdOrStructTyconRefReadOnlyAux g m isInref (tcref: TyconRef) = + if isInref && tcref.IsILStructOrEnumTycon then + isTyconRefReadOnly g m tcref + else + isTyconRefReadOnly g m tcref || isTyconRefAssumedReadOnly g tcref + +let isRecdOrStructTyconRefReadOnly g m tcref = + isRecdOrStructTyconRefReadOnlyAux g m false tcref + +let isRecdOrStructTyReadOnlyAux (g: TcGlobals) m isInref ty = match tryDestAppTy g ty with | ValueNone -> false - | ValueSome tcref -> isRecdOrStructTyconRefReadOnly g m tcref + | ValueSome tcref -> isRecdOrStructTyconRefReadOnlyAux g m isInref tcref + +let isRecdOrStructTyReadOnly g m ty = + isRecdOrStructTyReadOnlyAux g m false ty -let CanTakeAddressOf g m ty mut = +let CanTakeAddressOf g m isInref ty mut = match mut with | NeverMutates -> true - | PossiblyMutates -> isRecdOrStructTyReadOnly g m ty + | PossiblyMutates -> isRecdOrStructTyReadOnlyAux g m isInref ty | DefinitelyMutates -> false | AddressOfOp -> true // you can take the address but you might get a (readonly) inref as a result @@ -5980,7 +6018,7 @@ let CanTakeAddressOfImmutableVal (g: TcGlobals) m (vref: ValRef) mut = // || valRefInThisAssembly g.compilingFslib vref // This is because we don't actually guarantee to generate static backing fields for all values like these, e.g. simple constants "let x = 1". // We always generate a static property but there is no field to take an address of - CanTakeAddressOf g m vref.Type mut + CanTakeAddressOf g m false vref.Type mut let MustTakeAddressOfVal (g: TcGlobals) (vref: ValRef) = vref.IsMutable && @@ -5992,7 +6030,7 @@ let MustTakeAddressOfByrefGet (g: TcGlobals) (vref: ValRef) = let CanTakeAddressOfByrefGet (g: TcGlobals) (vref: ValRef) mut = isInByrefTy g vref.Type && - CanTakeAddressOf g vref.Range (destByrefTy g vref.Type) mut + CanTakeAddressOf g vref.Range true (destByrefTy g vref.Type) mut let MustTakeAddressOfRecdField (rfref: RecdField) = // Static mutable fields must be private, hence we don't have to take their address @@ -6005,14 +6043,18 @@ let CanTakeAddressOfRecdFieldRef (g: TcGlobals) m (rfref: RecdFieldRef) tinst mu // We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib rfref.TyconRef && not rfref.RecdField.IsMutable && - CanTakeAddressOf g m (actualTyOfRecdFieldRef rfref tinst) mut + CanTakeAddressOf g m false (actualTyOfRecdFieldRef rfref tinst) mut let CanTakeAddressOfUnionFieldRef (g: TcGlobals) m (uref: UnionCaseRef) cidx tinst mut = // We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib uref.TyconRef && let rfref = uref.FieldByIndex cidx not rfref.IsMutable && - CanTakeAddressOf g m (actualTyOfUnionFieldRef uref cidx tinst) mut + CanTakeAddressOf g m false (actualTyOfUnionFieldRef uref cidx tinst) mut + +let mkDerefAddrExpr mAddrGet expr mExpr exprTy = + let v, _ = mkCompGenLocal mAddrGet "byrefReturn" exprTy + mkCompGenLet mExpr v expr (mkAddrGet mAddrGet (mkLocalValRef v)) /// Make the address-of expression and return a wrapper that adds any allocated locals at an appropriate scope. /// Also return a flag that indicates if the resulting pointer is a not a pointer where writing is allowed and will @@ -6150,8 +6192,12 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress // Take a defensive copy let tmp, _ = match mut with - | NeverMutates -> mkCompGenLocal m "copyOfStruct" ty + | NeverMutates -> mkCompGenLocal m "copyOfStruct" ty | _ -> mkMutableCompGenLocal m "copyOfStruct" ty + + // This local is special in that it ignore byref scoping rules. + tmp.SetIgnoresByrefScope() + let readonly = true let writeonly = false Some (tmp, expr), (mkValAddr m readonly (mkLocalValRef tmp)), readonly, writeonly @@ -8569,6 +8615,7 @@ let IsSimpleSyntacticConstantExpr g inputExpr = | UncheckedDefaultOfExpr g _ | SizeOfExpr g _ | TypeOfExpr g _ -> true + | NameOfExpr g _ when g.langVersion.SupportsFeature LanguageFeature.NameOf -> true // All others are not simple constant expressions | _ -> false @@ -8939,3 +8986,19 @@ let isThreadOrContextStatic g attrs = let mkUnitDelayLambda (g: TcGlobals) m e = let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e, tyOfExpr g e) + + +let isStaticClass (g:TcGlobals) (x: EntityRef) = + not x.IsModuleOrNamespace && + x.TyparsNoRange.IsEmpty && + ((x.IsILTycon && + x.ILTyconRawMetadata.IsSealed && + x.ILTyconRawMetadata.IsAbstract) +#if !NO_EXTENSIONTYPING + || (x.IsProvided && + match x.TypeReprInfo with + | TProvidedTypeExtensionPoint info -> info.IsSealed && info.IsAbstract + | _ -> false) +#endif + || (not x.IsILTycon && not x.IsProvided && HasFSharpAttribute g g.attrib_AbstractClassAttribute x.Attribs)) && + not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute x.Attribs) diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index b0743de853..6119007d52 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -369,6 +369,9 @@ exception DefensiveCopyWarning of string * range type Mutates = AddressOfOp | DefinitelyMutates | PossiblyMutates | NeverMutates +/// Helper to create an expression that dereferences an address. +val mkDerefAddrExpr: mAddrGet: range -> expr: Expr -> mExpr: range -> exprTy: TType -> Expr + /// Helper to take the address of an expression val mkExprAddrOfExprAux : TcGlobals -> bool -> bool -> Mutates -> Expr -> ValRef option -> range -> (Val * Expr) option * Expr * bool * bool @@ -2240,6 +2243,8 @@ val (|EnumExpr|_|) : TcGlobals -> Expr -> Expr option val (|TypeOfExpr|_|) : TcGlobals -> Expr -> TType option val (|TypeDefOfExpr|_|) : TcGlobals -> Expr -> TType option +val (|NameOfExpr|_|) : TcGlobals -> Expr -> TType option +val (|SeqExpr|_|) : TcGlobals -> Expr -> unit option val EvalLiteralExprOrAttribArg: TcGlobals -> Expr -> Expr @@ -2302,3 +2307,4 @@ val isThreadOrContextStatic: TcGlobals -> Attrib list -> bool val mkUnitDelayLambda: TcGlobals -> range -> Expr -> Expr +val isStaticClass: g: TcGlobals -> tcref: TyconRef -> bool \ No newline at end of file diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 1aa14c5794..38b1e7d1d6 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -22,6 +22,7 @@ open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.Lib open FSharp.Compiler.PrettyNaming +open FSharp.Compiler.Features open Internal.Utilities @@ -180,8 +181,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d // The helper to find system types amongst referenced DLLs tryFindSysTypeCcu, emitDebugInfoInQuotations: bool, noDebugData: bool, - pathMap: PathMap) = - + pathMap: PathMap, langVersion: LanguageVersion) = + let vara = NewRigidTypar "a" envRange let varb = NewRigidTypar "b" envRange let varc = NewRigidTypar "c" envRange @@ -239,7 +240,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d // Search for a type. If it is not found, leave a dangling CCU reference with some useful diagnostic information should // the type actually be dereferenced let findSysTypeCcu path typeName = - match tryFindSysTypeCcu path typeName with + match tryFindSysTypeCcu path typeName with | None -> CcuThunk.CreateDelayed(dummyAssemblyNameCarryingUsefulErrorInformation path typeName) | Some ccu -> ccu @@ -664,6 +665,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_typeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typeof" , None , Some "TypeOf" , [vara], ([], v_system_Type_ty)) let v_methodhandleof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "methodhandleof" , None , Some "MethodHandleOf", [vara;varb], ([[varaTy --> varbTy]], v_system_RuntimeMethodHandle_ty)) let v_sizeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "sizeof" , None , Some "SizeOf" , [vara], ([], v_int_ty)) + let v_nameof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nameof" , None , Some "NameOf" , [vara], ([[varaTy]], v_string_ty)) + let v_unchecked_defaultof_info = makeIntrinsicValRef(fslib_MFOperatorsUnchecked_nleref, "defaultof" , None , Some "DefaultOf", [vara], ([], varaTy)) let v_typedefof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typedefof" , None , Some "TypeDefOf", [vara], ([], v_system_Type_ty)) let v_range_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Range" , None , None , [vara], ([[varaTy];[varaTy]], mkSeqTy varaTy)) @@ -902,6 +905,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.emitDebugInfoInQuotations = emitDebugInfoInQuotations member __.directoryToResolveRelativePaths= directoryToResolveRelativePaths member __.pathMap = pathMap + member __.langVersion = langVersion member __.unionCaseRefEq x y = primUnionCaseRefEq compilingFslib fslibCcu x y member __.valRefEq x y = primValRefEq compilingFslib fslibCcu x y member __.fslibCcu = fslibCcu @@ -1331,6 +1335,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val methodhandleof_vref = ValRefForIntrinsic v_methodhandleof_info member val typeof_vref = ValRefForIntrinsic v_typeof_info member val sizeof_vref = ValRefForIntrinsic v_sizeof_info + member val nameof_vref = ValRefForIntrinsic v_nameof_info member val typedefof_vref = ValRefForIntrinsic v_typedefof_info member val enum_vref = ValRefForIntrinsic v_enum_operator_info member val enumOfValue_vref = ValRefForIntrinsic v_enumOfValue_info @@ -1358,15 +1363,15 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val unbox_fast_vref = ValRefForIntrinsic v_unbox_fast_info member val istype_vref = ValRefForIntrinsic v_istype_info member val istype_fast_vref = ValRefForIntrinsic v_istype_fast_info - member val query_source_vref = ValRefForIntrinsic v_query_source_info - member val query_value_vref = ValRefForIntrinsic v_query_value_info - member val query_run_value_vref = ValRefForIntrinsic v_query_run_value_info - member val query_run_enumerable_vref = ValRefForIntrinsic v_query_run_enumerable_info - member val query_for_vref = ValRefForIntrinsic v_query_for_value_info - member val query_yield_vref = ValRefForIntrinsic v_query_yield_value_info - member val query_yield_from_vref = ValRefForIntrinsic v_query_yield_from_value_info - member val query_select_vref = ValRefForIntrinsic v_query_select_value_info - member val query_where_vref = ValRefForIntrinsic v_query_where_value_info + member val query_source_vref = ValRefForIntrinsic v_query_source_info + member val query_value_vref = ValRefForIntrinsic v_query_value_info + member val query_run_value_vref = ValRefForIntrinsic v_query_run_value_info + member val query_run_enumerable_vref = ValRefForIntrinsic v_query_run_enumerable_info + member val query_for_vref = ValRefForIntrinsic v_query_for_value_info + member val query_yield_vref = ValRefForIntrinsic v_query_yield_value_info + member val query_yield_from_vref = ValRefForIntrinsic v_query_yield_from_value_info + member val query_select_vref = ValRefForIntrinsic v_query_select_value_info + member val query_where_vref = ValRefForIntrinsic v_query_where_value_info member val query_zero_vref = ValRefForIntrinsic v_query_zero_value_info member __.seq_collect_info = v_seq_collect_info diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 7610c4f209..5cc848e5ab 100644 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -36,6 +36,7 @@ open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.NameResolution open FSharp.Compiler.PrettyNaming open FSharp.Compiler.InfoReader +open FSharp.Compiler.Features #if !NO_EXTENSIONTYPING open FSharp.Compiler.ExtensionTyping @@ -357,7 +358,7 @@ let AddLocalExnDefnAndReport tcSink scopem env (exnc: Tycon) = /// Add a list of type definitions to TcEnv let AddLocalTyconRefs ownDefinition g amap m tcrefs env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap m false env.eNameResEnv tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.No ownDefinition g amap env.eAccessRights m false env.eNameResEnv tcrefs } /// Add a list of type definitions to TcEnv let AddLocalTycons g amap m (tycons: Tycon list) env = @@ -370,11 +371,11 @@ let AddLocalTyconsAndReport tcSink scopem g amap m tycons env = CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env -/// Adjust the TcEnv to account for opening the set of modules and namespaces implied by an `open` declaration -let OpenModulesOrNamespaces tcSink g amap scopem root env mvvs openDeclaration = +/// Adjust the TcEnv to account for opening the set of modules, namespaces or static classes implied by an `open` declaration +let OpenEntities tcSink g amap scopem root env mvvs openDeclaration = let env = if isNil mvvs then env else - { env with eNameResEnv = AddModulesAndNamespacesContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs } + { env with eNameResEnv = AddEntitiesContentsToNameEnv g amap env.eAccessRights scopem root env.eNameResEnv mvvs } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) CallOpenDeclarationSink tcSink openDeclaration env @@ -406,7 +407,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu: CcuThunk, internalsVisib let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = if isNil tcrefs then env else - { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap scopem true env.eNameResEnv tcrefs } + { env with eNameResEnv = AddTyconRefsToNameEnv BulkAdd.Yes false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs } env /// Adjust the TcEnv to account for a fully processed "namespace" declaration in thie file @@ -417,7 +418,7 @@ let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp: ModuleOrNamesp let tcrefs = mtyp.TypeAndExceptionDefinitions |> List.map mkLocalTyconRef let env = AddRootModuleOrNamespaceRefs g amap scopem env modrefs let env = { env with - eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap scopem true env.eNameResEnv tcrefs + eNameResEnv = if isNil tcrefs then env.eNameResEnv else AddTyconRefsToNameEnv BulkAdd.No false g amap env.eAccessRights scopem true env.eNameResEnv tcrefs eUngeneralizableItems = addFreeItemOfModuleTy mtyp env.eUngeneralizableItems } CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env @@ -644,11 +645,11 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = match enclosingNamespacePathToOpen with | id :: rest -> let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap scopem true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap scopem true true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs let openDecl = OpenDeclaration.Create (enclosingNamespacePathToOpen, modrefs, scopem, true) - OpenModulesOrNamespaces tcSink g amap scopem false env modrefs openDecl + OpenEntities tcSink g amap scopem false env modrefs openDecl | Exception _ -> env | _ -> env @@ -846,6 +847,10 @@ let UnifyUnitType cenv (env: TcEnv) m ty expr = false +let TryUnifyUnitTypeWithoutWarning cenv (env:TcEnv) m ty = + let denv = env.DisplayEnv + AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv cenv.css m ty cenv.g.unit_ty + // Logically extends System.AttributeTargets module AttributeTargets = let FieldDecl = AttributeTargets.Field ||| AttributeTargets.Property @@ -3389,8 +3394,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let currentExpr, enumElemTy = // Implicitly dereference byref for expr 'for x in ...' if isByrefTy cenv.g enumElemTy then - let v, _ = mkCompGenLocal m "byrefReturn" enumElemTy - let expr = mkCompGenLet currentExpr.Range v currentExpr (mkAddrGet m (mkLocalValRef v)) + let expr = mkDerefAddrExpr m currentExpr currentExpr.Range enumElemTy expr, destByrefTy cenv.g enumElemTy else currentExpr, enumElemTy @@ -3513,35 +3517,84 @@ let (|ExprAsPat|_|) (f: SynExpr) = None | _ -> None +/// Check if a computation or sequence expression is syntactically free of 'yield' (though not yield!) +let YieldFree cenv expr = + if cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield then + + // Implement yield free logic for F# Language including the LanguageFeature.ImplicitYield + let rec YieldFree expr = + match expr with + | SynExpr.Sequential (_, _, e1, e2, _) -> + YieldFree e1 && YieldFree e2 + + | SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> + YieldFree e2 && Option.forall YieldFree e3opt + + | SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> + YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + + | (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) -> + clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + + | SynExpr.For (_, _, _, _, _, body, _) + | SynExpr.TryFinally (body, _, _, _, _) + | SynExpr.LetOrUse (_, _, _, body, _) + | SynExpr.While (_, _, body, _) + | SynExpr.ForEach (_, _, _, _, _, body, _) -> + YieldFree body + + | SynExpr.LetOrUseBang(_, _, _, _, _, body, _) -> + YieldFree body + + | SynExpr.YieldOrReturn((true, _), _, _) -> false + + | _ -> true + + YieldFree expr + else + // Implement yield free logic for F# Language without the LanguageFeature.ImplicitYield + let rec YieldFree expr = + match expr with + | SynExpr.Sequential (_, _, e1, e2, _) -> + YieldFree e1 && YieldFree e2 + + | SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> + YieldFree e2 && Option.forall YieldFree e3opt + + | SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> + YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + + | (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) -> + clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + + | SynExpr.For (_, _, _, _, _, body, _) + | SynExpr.TryFinally (body, _, _, _, _) + | SynExpr.LetOrUse (_, _, _, body, _) + | SynExpr.While (_, _, body, _) + | SynExpr.ForEach (_, _, _, _, _, body, _) -> + YieldFree body + + | SynExpr.LetOrUseBang _ + | SynExpr.YieldOrReturnFrom _ + | SynExpr.YieldOrReturn _ + | SynExpr.ImplicitZero _ + | SynExpr.Do _ -> false + + | _ -> true + + YieldFree expr + + /// Determine if a syntactic expression inside 'seq { ... }' or '[...]' counts as a "simple sequence /// of semicolon separated values". For example [1;2;3]. /// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized /// -let (|SimpleSemicolonSequence|_|) acceptDeprecated c = - - let rec YieldFree expr = - match expr with - | SynExpr.Sequential (_, _, e1, e2, _) -> YieldFree e1 && YieldFree e2 - | SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> YieldFree e2 && Option.forall YieldFree e3opt - | SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) - | (SynExpr.Match (_, _, clauses, _) | SynExpr.MatchBang (_, _, clauses, _)) -> - clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) - | SynExpr.For (_, _, _, _, _, body, _) - | SynExpr.TryFinally (body, _, _, _, _) - | SynExpr.LetOrUse (_, _, _, body, _) - | SynExpr.While (_, _, body, _) - | SynExpr.ForEach (_, _, _, _, _, body, _) -> YieldFree body - | SynExpr.YieldOrReturnFrom _ - | SynExpr.YieldOrReturn _ - | SynExpr.LetOrUseBang _ - | SynExpr.ImplicitZero _ - | SynExpr.Do _ -> false - | _ -> true +let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = - let rec IsSimpleSemicolonSequenceElement expr = - match expr with - | SynExpr.IfThenElse _ when acceptDeprecated && YieldFree expr -> true - | SynExpr.IfThenElse _ + let IsSimpleSemicolonSequenceElement expr = + match expr with + | SynExpr.IfThenElse _ when acceptDeprecated && YieldFree cenv expr -> true + | SynExpr.IfThenElse _ | SynExpr.TryWith _ | SynExpr.Match _ | SynExpr.For _ @@ -3553,15 +3606,14 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c = | SynExpr.Do _ | SynExpr.MatchBang _ | SynExpr.LetOrUseBang _ - | SynExpr.ImplicitZero _ | SynExpr.While _ -> false | _ -> true - let rec GetSimpleSemicolonSequenceOfComprehension expr acc = + let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc = match expr with | SynExpr.Sequential (_, true, e1, e2, _) -> if IsSimpleSemicolonSequenceElement e1 then - GetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc) + TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc) else None | e -> @@ -3570,10 +3622,7 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c = else None - if YieldFree c then - GetSimpleSemicolonSequenceOfComprehension c [] - else - None + TryGetSimpleSemicolonSequenceOfComprehension cexpr [] //------------------------------------------------------------------------- // Mutually recursive shapes @@ -4089,9 +4138,8 @@ let buildApp cenv expr resultTy arg m = | _ when isByrefTy g resultTy -> // Handle byref returns, byref-typed returns get implicitly dereferenced - let v, _ = mkCompGenLocal m "byrefReturn" resultTy let expr = expr.SupplyArgument (arg, m) - let expr = mkCompGenLet m v expr.Expr (mkAddrGet m (mkLocalValRef v)) + let expr = mkDerefAddrExpr m expr.Expr m resultTy let resultTy = destByrefTy g resultTy MakeApplicableExprNoFlex cenv expr, resultTy @@ -5680,6 +5728,12 @@ and TcStmt cenv env tpenv synExpr = else mkCompGenSequential m expr (mkUnit cenv.g m), tpenv +and TryTcStmt cenv env tpenv synExpr = + let expr, ty, tpenv = TcExprOfUnknownType cenv env tpenv synExpr + let m = synExpr.Range + let hasTypeUnit = TryUnifyUnitTypeWithoutWarning cenv env m ty + hasTypeUnit, expr, tpenv + /// During checking of expressions of the form (x(y)).z(w1, w2) /// keep a stack of things on the right. This lets us recognize /// method applications and other item-based syntax. @@ -5748,6 +5802,13 @@ and TcExprUndelayedNoType cenv env tpenv synExpr: Expr * TType * _ = expr, overallTy, tpenv and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = + + // LanguageFeatures.ImplicitYield do not require this validation + let implicitYieldEnabled = cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled + let validateExpressionWithIfRequiresParenethesis = not implicitYieldEnabled + let acceptDeprecatedIfThenExpression = not implicitYieldEnabled + match synExpr with | SynExpr.Paren (expr2, _, _, mWholeExprIncludingParentheses) -> // We invoke CallExprHasTypeSink for every construct which is atomic in the syntax, i.e. where a '.' immediately following the @@ -5946,25 +6007,23 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = match comp with | SynExpr.New _ -> errorR(Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm(), m)) - | SimpleSemicolonSequence false _ -> + | SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression -> errorR(Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression(), m)) | _ -> () if not !isNotNakedRefCell && not cenv.g.compilingFslib then error(Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm(), m)) - TcComputationOrSequenceExpression cenv env overallTy m None tpenv comp + TcSequenceExpression cenv env tpenv comp overallTy m | SynExpr.ArrayOrListOfSeqExpr (isArray, comp, m) -> CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) - match comp with - | SynExpr.CompExpr (_, _, (SimpleSemicolonSequence true elems as body), _) -> - match body with - | SimpleSemicolonSequence false _ -> - () - | _ -> - errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m)) + | SynExpr.CompExpr (_, _, (SimpleSemicolonSequence cenv acceptDeprecatedIfThenExpression elems as body), _) -> + match body with + | SimpleSemicolonSequence cenv false _ -> () + | _ when validateExpressionWithIfRequiresParenethesis -> errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m)) + | _ -> () let replacementExpr = if isArray then @@ -6063,6 +6122,19 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = let expr2, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv synExpr2 Expr.Sequential (expr1, expr2, ThenDoSeq, sp, m), tpenv + // Used to implement the type-directed 'implicit yield' rule for computation expressions + | SynExpr.SequentialOrImplicitYield (sp, synExpr1, synExpr2, otherExpr, m) -> + let isStmt, expr1, tpenv = TryTcStmt cenv env tpenv synExpr1 + if isStmt then + let env = ShrinkContext env m synExpr2.Range + let expr2, tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv synExpr2 + Expr.Sequential(expr1, expr2, NormalSeq, sp, m), tpenv + else + // The first expression wasn't unit-typed, so proceed to the alternative interpretation + // Note a copy of the first expression is embedded in 'otherExpr' and thus + // this will type-check the first expression over again. + TcExpr cenv overallTy env tpenv otherExpr + | SynExpr.Do (synInnerExpr, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty TcStmtThatCantBeCtorBody cenv env tpenv synInnerExpr @@ -6892,7 +6964,7 @@ and TcConstExpr cenv overallTy env m tpenv c = let expr = let modName = "NumericLiteral" + suffix let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with | Result [] | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m)) | Result ((_, mref, _) :: _) -> @@ -7336,24 +7408,13 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper, raw, ast, isFromQueryExpres // We serialize the quoted expression to bytes in IlxGen after type inference etc. is complete. expr, tpenv -//------------------------------------------------------------------------- -// TcComputationOrSequenceExpression -//------------------------------------------------------------------------- - -and TcComputationOrSequenceExpression cenv (env: TcEnv) overallTy m interpValOpt tpenv comp = - match interpValOpt with - | Some (interpExpr: Expr, builderTy) -> - TcComputationExpression cenv env overallTy m interpExpr builderTy tpenv comp - | None -> - TcSequenceExpression cenv env tpenv comp overallTy m - /// Ignores an attribute and IgnoreAttribute _ = None -// Used for all computation expressions except sequence expressions -and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv comp = +/// Used for all computation expressions except sequence expressions +and TcComputationExpression cenv env overallTy mWhole (interpExpr: Expr) builderTy tpenv (comp: SynExpr) = - //dprintfn "TcComputationOrSequenceExpression, comp = \n%A\n-------------------\n" comp + //dprintfn "TcComputationExpression, comp = \n%A\n-------------------\n" comp let ad = env.eAccessRights let mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e @@ -7382,19 +7443,18 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let builderVal = mkSynIdGet m builderValName mkSynApp1 (SynExpr.DotGet (builderVal, range0, LongIdentWithDots([mkSynId m nm], []), m)) args m - let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy + let hasMethInfo nm = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy |> isNil |> not + + let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy + // Optionally wrap sources of "let!", "yield!", "use!" in "query.Source" let mkSourceExpr callExpr = match sourceMethInfo with | [] -> callExpr | _ -> mkSynCall "Source" callExpr.Range [callExpr] - /// Decide if the builder is an auto-quote builder - let isAutoQuote = - match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Quote" builderTy with - | [] -> false - | _ -> true + let isAutoQuote = hasMethInfo "Quote" let customOperationMethods = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides mBuilderVal builderTy @@ -7552,7 +7612,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (_, argInfo) = List.item i argInfos HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs - let (|ForEachThen|_|) e = match e with | SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential (_, true, clause, rest, _), _) -> Some (isFromSource, pat1, expr1, clause, rest) @@ -7705,7 +7764,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | _ -> None - let (|StripApps|) e = let rec strip e = match e with @@ -7764,6 +7822,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | SynExpr.Sequential (_sp, true, dataComp1, dataComp2, _) -> (dataComp1, Some dataComp2) | _ -> (e, None) + // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) + // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay + // NOTE: we should probably suppress these sequence points altogether + let rangeForCombine innerComp1 = + match innerComp1 with + | SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen + | SynExpr.Match (SequencePointAtBinding mMatch, _, _, _) -> mMatch + | SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry + | SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry + | SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind + | SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind + | SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile + | _ -> innerComp1.Range + // Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag let checkForBinaryApp comp = match comp with @@ -7794,6 +7866,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let emptyVarSpace = LazyWithContext.NotLazy ([], env) + // If there are no 'yield' in the computation expression, and the builder supports 'Yield', + // then allow the type-directed rule interpreting non-unit-typed expressions in statement + // positions as 'yield'. 'yield!' may be present in the computation expression. + let enableImplicitYield = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + && (hasMethInfo "Yield" && hasMethInfo "Combine" && hasMethInfo "Delay" && YieldFree cenv comp) + // q - a flag indicating if custom operators are allowed. They are not allowed inside try/with, try/finally, if/then/else etc. // varSpace - a lazy data structure indicating the variables bound so far in the overall computation // comp - the computation expression being analyzed @@ -8160,16 +8239,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay // NOTE: we should probably suppress these sequence points altogether - let m1 = - match innerComp1 with - | SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen - | SynExpr.Match (SequencePointAtBinding mMatch, _, _, _) -> mMatch - | SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry - | SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry - | SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind - | SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind - | SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile - | _ -> innerComp1.Range + let m1 = rangeForCombine innerComp1 if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"), m)) if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]])) @@ -8185,7 +8255,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(trans true q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) // "expr; cexpr" is treated as sequential execution | _ -> - Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential (sp, true, innerComp1, holeFill, m)))) + Some (trans true q varSpace innerComp2 (fun holeFill -> + let fillExpr = + if enableImplicitYield then + // When implicit yields are enabled, then if the 'innerComp1' checks as type + // 'unit' we interpret the expression as a sequential, and when it doesn't + // have type 'unit' we interpret it as a 'Yield + Combine'. + let combineExpr = + let m1 = rangeForCombine innerComp1 + let implicitYieldExpr = mkSynCall "Yield" comp.Range [innerComp1] + mkSynCall "Combine" m1 [implicitYieldExpr; mkSynCall "Delay" m1 [mkSynDelay holeFill.Range holeFill]] + SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) + else + SynExpr.Sequential(sp, true, innerComp1, holeFill, m) + translatedCtxt fillExpr)) | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) -> match elseCompOpt with @@ -8314,7 +8397,6 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some (translatedCtxt yieldExpr) else Some (translatedCtxt (mkSynCall "ReturnFrom" m [yieldExpr])) - | SynExpr.YieldOrReturn ((isYield, _), yieldExpr, m) -> let methName = (if isYield then "Yield" else "Return") @@ -8324,7 +8406,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | _ -> None - and transNoQueryOps comp = trans true false emptyVarSpace comp id + and transNoQueryOps comp = + trans true false emptyVarSpace comp id + and trans firstTry q varSpace comp translatedCtxt = match tryTrans firstTry q varSpace comp translatedCtxt with | Some e -> e @@ -8340,8 +8424,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else - SynExpr.YieldOrReturn ((false, true), SynExpr.Const (SynConst.Unit, m), m) - trans true q varSpace (SynExpr.LetOrUseBang (NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt + SynExpr.YieldOrReturn((false, true), SynExpr.Const (SynConst.Unit, m), m) + trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt + // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" | _ -> @@ -8353,21 +8438,27 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match comp with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), comp.RangeOfFirstPortion)) - trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential (SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range))) + trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> + let fillExpr = + if enableImplicitYield then + let implicitYieldExpr = mkSynCall "Yield" comp.Range [comp] + SynExpr.SequentialOrImplicitYield(SuppressSequencePointOnStmtOfSequential, comp, holeFill, implicitYieldExpr, comp.Range) + else + SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range) + translatedCtxt fillExpr) - let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) + let basicSynExpr = + trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) let delayedExpr = match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Delay" builderTy with | [] -> basicSynExpr | _ -> mkSynCall "Delay" mBuilderVal [(mkSynDelay2 basicSynExpr)] - let quotedSynExpr = if isAutoQuote then SynExpr.Quote (mkSynIdGet (mBuilderVal.MakeSynthetic()) (CompileOpName "<@ @>"), (*isRaw=*)false, delayedExpr, (*isFromQueryExpression=*)true, mWhole) else delayedExpr - let runExpr = match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Run" builderTy with @@ -8405,6 +8496,13 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = // Allow subsumption at 'yield' if the element type is nominal prior to the analysis of the body of the sequence expression let flex = not (isTyparTy cenv.g genEnumElemTy) + // If there are no 'yield' in the computation expression then allow the type-directed rule + // interpreting non-unit-typed expressions in statement positions as 'yield'. 'yield!' may be + // present in the computation expression. + let enableImplicitYield = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + && (YieldFree cenv comp) + let mkDelayedExpr (coreExpr: Expr) = let m = coreExpr.Range let overallTy = tyOfExpr cenv.g coreExpr @@ -8464,7 +8562,8 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let innerExprMark = innerExpr.Range Some(mkSeqFinally cenv env innerExprMark genOuterTy innerExpr unwindExpr, tpenv) - | SynExpr.Paren (_, _, _, m) -> + + | SynExpr.Paren (_, _, _, m) when not (cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield)-> error(Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression(), m)) | SynExpr.ImplicitZero m -> @@ -8476,17 +8575,15 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> // "expr; cexpr" is treated as sequential execution // "cexpr; cexpr" is treated as append - match tryTcSequenceExprBody env genOuterTy tpenv innerComp1 with - | None -> - let innerExpr1, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv innerComp1 - let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 - - Some(Expr.Sequential (innerExpr1, innerExpr2, NormalSeq, sp, m), tpenv) - - | Some (innerExpr1, tpenv) -> + let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv innerComp1 + match res with + | Choice1Of2 innerExpr1 -> let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 let innerExpr2 = mkDelayedExpr innerExpr2 Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) + | Choice2Of2 stmt1 -> + let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 + Some(Expr.Sequential(stmt1, innerExpr2, NormalSeq, sp, m), tpenv) | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToThen, mIfToEndOfElseBranch) -> let guardExpr', tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr @@ -8560,15 +8657,34 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = | _ -> None and tcSequenceExprBody env genOuterTy tpenv comp = + let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp + match res with + | Choice1Of2 expr -> + expr, tpenv + | Choice2Of2 stmt -> + let m = comp.Range + let resExpr = Expr.Sequential(stmt, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m) + resExpr, tpenv + + and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp = match tryTcSequenceExprBody env genOuterTy tpenv comp with - | Some e -> e + | Some (expr, tpenv) -> Choice1Of2 expr, tpenv | None -> - // seq { ...; expr } is treated as 'seq { ... ; expr; yield! Seq.empty }' - // Note this means seq { ...; () } is treated as 'seq { ... ; (); yield! Seq.empty }' - let m = comp.Range let env = { env with eContextInfo = ContextInfo.SequenceExpression genOuterTy } - let expr, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp - Expr.Sequential (expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv + if enableImplicitYield then + let hasTypeUnit, expr, tpenv = TryTcStmt cenv env tpenv comp + if hasTypeUnit then + Choice2Of2 expr, tpenv + else + let genResultTy = NewInferenceType () + UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) + let exprTy = tyOfExpr cenv.g expr + AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css m NoTrace genResultTy exprTy + let resExpr = mkCallSeqSingleton cenv.g m genResultTy (mkCoerceExpr(expr, genResultTy, m, exprTy)) + Choice1Of2 resExpr, tpenv + else + let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp + Choice2Of2 stmt, tpenv let coreExpr, tpenv = tcSequenceExprBody env overallTy tpenv comp let delayedExpr = mkDelayedExpr coreExpr @@ -8704,41 +8820,91 @@ and delayRest rest mPrior delayed = let mPriorAndLongId = unionRanges mPrior (rangeOfLid longId) DelayedDotLookup (rest, mPriorAndLongId) :: delayed +/// Typecheck "nameof" expressions +and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = + + let rec stripParens expr = + match expr with + | SynExpr.Paren(expr, _, _, _) -> stripParens expr + | _ -> expr + + let cleanSynArg = stripParens synArg + let m = cleanSynArg.Range + let rec check overallTyOpt expr (delayed: DelayedItem list) = + match expr with + | LongOrSingleIdent (false, (LongIdentWithDots(longId, _) as lidd), _, _) when longId.Length > 0 -> + let ad = env.eAccessRights + let id, rest = List.headAndTail longId + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest true with + | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> + () // resolved to a module or namespace, done with checks + | _ -> + let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with + | Result tcref when IsEntityAccessible cenv.amap m ad tcref -> + () // resolved to a type name, done with checks + | _ -> + let overallTy = match overallTyOpt with None -> NewInferenceType() | Some t -> t + let _, _ = TcLongIdentThen cenv overallTy env tpenv lidd delayed + () // checked as an expression, done with checks + List.last longId + + | SynExpr.TypeApp (hd, _, types, _, _, _, m) -> + check overallTyOpt hd (DelayedTypeApp(types, m, m) :: delayed) + + | SynExpr.Paren(expr, _, _, _) when overallTyOpt.IsNone && delayed.IsEmpty -> + check overallTyOpt expr [] + | SynExpr.Typed (synBodyExpr, synType, _m) when delayed.IsEmpty && overallTyOpt.IsNone -> + let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + check (Some tgtTy) synBodyExpr [] + + | _ -> + error (Error(FSComp.SR.expressionHasNoName(), m)) + + let lastIdent = check None cleanSynArg [] + let constRange = mkRange m.FileName m.Start (mkPos m.StartLine (m.StartColumn + lastIdent.idText.Length + 2)) // `2` are for quotes + Expr.Const(Const.String(lastIdent.idText), constRange, cenv.g.string_ty) + //------------------------------------------------------------------------- // TcFunctionApplicationThen: Typecheck "expr x" + projections //------------------------------------------------------------------------- and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty (synArg: SynExpr) atomicFlag delayed = - let denv = env.DisplayEnv let mArg = synArg.Range let mFunExpr = expr.Range + // If the type of 'synArg' unifies as a function type, then this is a function application, otherwise // it is an error or a computation expression match UnifyFunctionTypeUndoIfFailed cenv denv mFunExpr exprty with - | ValueSome (domainTy, resultTy) -> - - // Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library. - // Set a flag in the syntax tree to say we noticed a leading 'seq' - match synArg with - | SynExpr.CompExpr (false, isNotNakedRefCell, _comp, _m) -> - isNotNakedRefCell := - !isNotNakedRefCell - || - (match expr with - | ApplicableExpr(_, Expr.Op (TOp.Coerce, _, [Expr.App (Expr.Val (vf, _, _), _, _, _, _)], _), _) when valRefEq cenv.g vf cenv.g.seq_vref -> true - | _ -> false) - | _ -> () - - let arg, tpenv = TcExpr cenv domainTy env tpenv synArg - let exprAndArg, resultTy = buildApp cenv expr resultTy arg mExprAndArg - TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed - | _ -> + | ValueSome (domainTy, resultTy) -> + match expr with + | ApplicableExpr(_, NameOfExpr cenv.g _, _) when cenv.g.langVersion.SupportsFeature LanguageFeature.NameOf -> + let replacementExpr = TcNameOfExpr cenv env tpenv synArg + TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true)) cenv.g.string_ty ExprAtomicFlag.Atomic delayed + | _ -> + // Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library. + // Set a flag in the syntax tree to say we noticed a leading 'seq' + match synArg with + | SynExpr.CompExpr (false, isNotNakedRefCell, _comp, _m) -> + isNotNakedRefCell := + !isNotNakedRefCell + || + (match expr with + | ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [SeqExpr cenv.g], _), _) -> true + | _ -> false) + | _ -> () + + let arg, tpenv = TcExpr cenv domainTy env tpenv synArg + let exprAndArg, resultTy = buildApp cenv expr resultTy arg mExprAndArg + TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed + + | ValueNone -> // OK, 'expr' doesn't have function type, but perhaps 'expr' is a computation expression builder, and 'arg' is '{ ... }' match synArg with | SynExpr.CompExpr (false, _isNotNakedRefCell, comp, _m) -> - let bodyOfCompExpr, tpenv = TcComputationOrSequenceExpression cenv env overallTy mFunExpr (Some(expr.Expr, exprty)) tpenv comp + let bodyOfCompExpr, tpenv = TcComputationExpression cenv env overallTy mFunExpr expr.Expr exprty tpenv comp TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr cenv.g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed | _ -> error (NotAFunction(denv, overallTy, mFunExpr, mArg)) @@ -8747,25 +8913,26 @@ and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty ( // TcLongIdentThen: Typecheck "A.B.C.E.F ... " constructs //------------------------------------------------------------------------- -and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) delayed = +and GetLongIdentTypeNameInfo delayed = + // Given 'MyOverloadedType.MySubType...' use the number of given type arguments to help + // resolve type name lookup of 'MyOverloadedType' + // Also determine if type names should resolve to Item.Types or Item.CtorGroup + match delayed with + | DelayedTypeApp (tyargs, _, _) :: (DelayedDot | DelayedDotLookup _) :: _ -> + // cases like 'MyType.Sth' + TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length) - let ad = env.eAccessRights - let typeNameResInfo = - // Given 'MyOverloadedType.MySubType...' use arity of #given type arguments to help - // resolve type name lookup of 'MyOverloadedType' - // Also determine if type names should resolve to Item.Types or Item.CtorGroup - match delayed with - | DelayedTypeApp (tyargs, _, _) :: (DelayedDot | DelayedDotLookup _) :: _ -> - // cases like 'MyType.Sth' - TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length) + | DelayedTypeApp (tyargs, _, _) :: _ -> + // Note, this also covers the case 'MyType.' (without LValue_get), which is needed for VS (when typing) + TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length) - | DelayedTypeApp (tyargs, _, _) :: _ -> - // Note, this also covers the case 'MyType.' (without LValue_get), which is needed for VS (when typing) - TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length) + | _ -> + TypeNameResolutionInfo.Default - | _ -> - TypeNameResolutionInfo.Default +and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) delayed = + let ad = env.eAccessRights + let typeNameResInfo = GetLongIdentTypeNameInfo delayed let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId TcItemThen cenv overallTy env tpenv nameResolutionResult delayed @@ -9121,6 +9288,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del | SynExpr.TryFinally _ | SynExpr.Lazy _ | SynExpr.Sequential _ + | SynExpr.SequentialOrImplicitYield _ | SynExpr.LetOrUse _ | SynExpr.DotSet _ | SynExpr.DotIndexedSet _ @@ -10044,8 +10212,7 @@ and TcMethodApplication // byref-typed returns get implicitly dereferenced let vty = tyOfExpr cenv.g callExpr0 if isByrefTy cenv.g vty then - let v, _ = mkCompGenLocal mMethExpr "byrefReturn" vty - mkCompGenLet mMethExpr v callExpr0 (mkAddrGet mMethExpr (mkLocalValRef v)) + mkDerefAddrExpr mMethExpr callExpr0 mMethExpr vty else callExpr0 @@ -12288,19 +12455,19 @@ let TcTyconMemberSpecs cenv env containerInfo declKind tpenv (augSpfn: SynMember // Bind 'open' declarations //------------------------------------------------------------------------- -let TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap (longId: Ident list) = +let TcOpenLidAndPermitAutoResolve tcSink env amap (longId : Ident list) = let ad = env.eAccessRights match longId with | [] -> [] | id :: rest -> let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges - match ResolveLongIndentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIndentAsModuleOrNamespaceOrStaticClass tcSink ResultCollectionSettings.AllResults amap m true true OpenQualified env.eNameResEnv ad id rest true with | Result res -> res | Exception err -> errorR(err); [] let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = - match TcModuleOrNamespaceLidAndPermitAutoResolve tcSink env amap longId with + match TcOpenLidAndPermitAutoResolve tcSink env amap longId with | [] -> env | modrefs -> @@ -12352,7 +12519,7 @@ let TcOpenDecl tcSink (g: TcGlobals) amap m scopem env (longId: Ident list) = modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult) let openDecl = OpenDeclaration.Create (longId, modrefs, scopem, false) - let env = OpenModulesOrNamespaces tcSink g amap scopem false env modrefs openDecl + let env = OpenEntities tcSink g amap scopem false env modrefs openDecl env @@ -13827,7 +13994,7 @@ module MutRecBindingChecking = let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false + | id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false let mvvs = ForceRaise resolved if isNil mvvs then env else let modrefs = mvvs |> List.map p23 @@ -16429,6 +16596,11 @@ module TcDeclarations = if not (isNil members) && tcref.IsTypeAbbrev then errorR(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveAugmentations(), tyDeclRange)) + let (ComponentInfo (attributes, _, _, _, _, _, _, _)) = synTyconInfo + if not (List.isEmpty attributes) && (declKind = ExtrinsicExtensionBinding || declKind = IntrinsicExtensionBinding) then + let attributeRange = (List.head attributes).Range + error(Error(FSComp.SR.tcAugmentationsCannotHaveAttributes(), attributeRange)) + MutRecDefnsPhase2DataForTycon(tyconOpt, innerParent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, members, tyDeclRange, newslotsOK, fixupFinalAttrs)) // By now we've established the full contents of type definitions apart from their @@ -16654,7 +16826,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIndentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest false + | id :: rest -> ResolveLongIndentAsModuleOrNamespaceOrStaticClass cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m false true OpenQualified env.eNameResEnv ad id rest false let mvvs = ForceRaise resolved let scopem = unionRanges m endm let unfilteredModrefs = mvvs |> List.map p23 @@ -17208,7 +17380,7 @@ let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env | ValueNone -> warn() | ValueSome _ -> let openDecl = OpenDeclaration.Create ([], [modref], scopem, false) - OpenModulesOrNamespaces TcResultsSink.NoSink g amap scopem root env [modref] openDecl + OpenEntities TcResultsSink.NoSink g amap scopem root env [modref] openDecl // Add the CCU and apply the "AutoOpen" attributes let AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisible) = diff --git a/src/fsharp/UnicodeLexing.fs b/src/fsharp/UnicodeLexing.fs index bb1c26dabf..d34092940e 100755 --- a/src/fsharp/UnicodeLexing.fs +++ b/src/fsharp/UnicodeLexing.fs @@ -7,22 +7,23 @@ module internal FSharp.Compiler.UnicodeLexing // open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.Features open Internal.Utilities -open System.IO +open System.IO open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -let StringAsLexbuf (s:string) : Lexbuf = - LexBuffer<_>.FromChars (s.ToCharArray()) - -let FunctionAsLexbuf (bufferFiller: char[] * int * int -> int) : Lexbuf = - LexBuffer<_>.FromFunction bufferFiller +let StringAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, s:string) : Lexbuf = + LexBuffer<_>.FromChars (supportsFeature, s.ToCharArray()) + +let FunctionAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, bufferFiller: char[] * int * int -> int) : Lexbuf = + LexBuffer<_>.FromFunction(supportsFeature, bufferFiller) + +let SourceTextAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, sourceText) = + LexBuffer.FromSourceText(supportsFeature, sourceText) -let SourceTextAsLexbuf sourceText = - LexBuffer.FromSourceText(sourceText) - // The choice of 60 retries times 50 ms is not arbitrary. The NTFS FILETIME structure // uses 2 second resolution for LastWriteTime. We retry long enough to surpass this threshold // plus 1 second. Once past the threshold the incremental builder will be able to retry asynchronously based @@ -41,7 +42,7 @@ let numRetries = 60 /// we can't just return the LexBuffer object, since the file it wraps wouldn't /// get closed when we're finished with the LexBuffer. Hence we return the stream, /// the reader and the LexBuffer. The caller should dispose the first two when done. -let UnicodeFileAsLexbuf (filename,codePage : int option, retryLocked:bool) : Lexbuf = +let UnicodeFileAsLexbuf (supportsFeature: Features.LanguageFeature -> bool, filename, codePage: int option, retryLocked: bool): Lexbuf = // Retry multiple times since other processes may be writing to this file. let rec getSource retryNumber = try @@ -68,5 +69,5 @@ let UnicodeFileAsLexbuf (filename,codePage : int option, retryLocked:bool) : Le else reraise() let source = getSource 0 - let lexbuf = LexBuffer<_>.FromChars(source.ToCharArray()) + let lexbuf = LexBuffer<_>.FromChars(supportsFeature, source.ToCharArray()) lexbuf diff --git a/src/fsharp/UnicodeLexing.fsi b/src/fsharp/UnicodeLexing.fsi index 7c0f0fb68d..2478c7f857 100755 --- a/src/fsharp/UnicodeLexing.fsi +++ b/src/fsharp/UnicodeLexing.fsi @@ -2,12 +2,13 @@ module internal FSharp.Compiler.UnicodeLexing +open FSharp.Compiler.Features open FSharp.Compiler.Text open Microsoft.FSharp.Text open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -val internal StringAsLexbuf : string -> Lexbuf -val public FunctionAsLexbuf : (char [] * int * int -> int) -> Lexbuf -val public UnicodeFileAsLexbuf :string * int option * (*retryLocked*) bool -> Lexbuf -val public SourceTextAsLexbuf : ISourceText -> Lexbuf +val internal StringAsLexbuf: (Features.LanguageFeature -> bool) * string -> Lexbuf +val public FunctionAsLexbuf: (Features.LanguageFeature -> bool) * (char [] * int * int -> int) -> Lexbuf +val public UnicodeFileAsLexbuf: (Features.LanguageFeature -> bool) * string * int option * (*retryLocked*) bool -> Lexbuf +val public SourceTextAsLexbuf: (Features.LanguageFeature -> bool) * ISourceText -> Lexbuf diff --git a/src/fsharp/XmlAdapters.fs b/src/fsharp/XmlAdapters.fs new file mode 100644 index 0000000000..4f48955945 --- /dev/null +++ b/src/fsharp/XmlAdapters.fs @@ -0,0 +1,23 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Core +open System.Reflection + +//Replacement for: System.Security.SecurityElement.Escape(line) All platforms +module internal XmlAdapters = + open System.Text + open Microsoft.FSharp.Collections + + let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |] + + let getEscapeSequence c = + match c with + | '<' -> "<" + | '>' -> ">" + | '\"' -> """ + | '\'' -> "'" + | '&' -> "&" + | _ as ch -> ch.ToString() + + let escape str = String.collect getEscapeSequence str + diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 46bb6b1420..59e93205ce 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -12,6 +12,7 @@ open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler open FSharp.Compiler.UnicodeLexing open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.PrettyNaming open FSharp.Compiler.Range @@ -671,7 +672,7 @@ and /// F# syntax: lazy expr | Lazy of SynExpr * range: range - /// Seq(seqPoint, isTrueSeq, e1, e2, m) + /// Sequential(seqPoint, isTrueSeq, e1, e2, m) /// isTrueSeq: false indicates "let v = a in b; v" /// /// F# syntax: expr; expr @@ -749,10 +750,12 @@ and /// Computation expressions only, based on JOIN_IN token from lex filter | JoinIn of SynExpr * range * SynExpr * range: range - /// F# syntax: - /// Computation expressions only, implied by final "do" or "do!" + /// Used internally during type checking for translating computation expressions. | ImplicitZero of range: range + /// Used internally during type checking for translating computation expressions. + | SequentialOrImplicitYield of seqPoint:SequencePointInfoForSeq * expr1:SynExpr * expr2:SynExpr * ifNotStmt:SynExpr * range:range + /// F# syntax: yield expr /// F# syntax: return expr /// Computation expressions only @@ -833,6 +836,7 @@ and | SynExpr.TryWith (range=m) | SynExpr.TryFinally (range=m) | SynExpr.Sequential (range=m) + | SynExpr.SequentialOrImplicitYield (range=m) | SynExpr.ArbitraryAfterError (range=m) | SynExpr.FromParseError (range=m) | SynExpr.DiscardAfterMissingQualificationAfterDot (range=m) @@ -872,138 +876,25 @@ and /// range ignoring any (parse error) extra trailing dots member e.RangeSansAnyExtraDot = match e with - | SynExpr.Paren (range=m) - | SynExpr.Quote (range=m) - | SynExpr.Const (range=m) - | SynExpr.Typed (range=m) - | SynExpr.Tuple (range=m) - | SynExpr.ArrayOrList (range=m) - | SynExpr.AnonRecd (range=m) - | SynExpr.Record (range=m) - | SynExpr.New (range=m) - | SynExpr.ObjExpr (range=m) - | SynExpr.While (range=m) - | SynExpr.For (range=m) - | SynExpr.ForEach (range=m) - | SynExpr.CompExpr (range=m) - | SynExpr.ArrayOrListOfSeqExpr (range=m) - | SynExpr.Lambda (range=m) - | SynExpr.Match (range=m) - | SynExpr.MatchLambda (range=m) - | SynExpr.Do (range=m) - | SynExpr.Assert (range=m) - | SynExpr.App (range=m) - | SynExpr.TypeApp (range=m) - | SynExpr.LetOrUse (range=m) - | SynExpr.TryWith (range=m) - | SynExpr.TryFinally (range=m) - | SynExpr.Sequential (range=m) - | SynExpr.ArbitraryAfterError (range=m) - | SynExpr.FromParseError (range=m) - | SynExpr.IfThenElse (range=m) - | SynExpr.LongIdentSet (range=m) - | SynExpr.NamedIndexedPropertySet (range=m) - | SynExpr.DotIndexedGet (range=m) - | SynExpr.DotIndexedSet (range=m) - | SynExpr.DotSet (range=m) - | SynExpr.Set (range=m) - | SynExpr.DotNamedIndexedPropertySet (range=m) - | SynExpr.LibraryOnlyUnionCaseFieldGet (range=m) - | SynExpr.LibraryOnlyUnionCaseFieldSet (range=m) - | SynExpr.LibraryOnlyILAssembly (range=m) - | SynExpr.LibraryOnlyStaticOptimization (range=m) - | SynExpr.TypeTest (range=m) - | SynExpr.Upcast (range=m) - | SynExpr.AddressOf (range=m) - | SynExpr.Downcast (range=m) - | SynExpr.JoinIn (range=m) - | SynExpr.InferredUpcast (range=m) - | SynExpr.InferredDowncast (range=m) - | SynExpr.Null (range=m) - | SynExpr.Lazy (range=m) - | SynExpr.TraitCall (range=m) - | SynExpr.ImplicitZero (range=m) - | SynExpr.YieldOrReturn (range=m) - | SynExpr.YieldOrReturnFrom (range=m) - | SynExpr.LetOrUseBang (range=m) - | SynExpr.MatchBang (range=m) - | SynExpr.DoBang (range=m) -> m | SynExpr.DotGet (expr, _, lidwd, m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then unionRanges expr.Range lidwd.RangeSansAnyExtraDot else m | SynExpr.LongIdent (_, lidwd, _, _) -> lidwd.RangeSansAnyExtraDot | SynExpr.DiscardAfterMissingQualificationAfterDot (expr, _) -> expr.Range - | SynExpr.Fixed (_, m) -> m - | SynExpr.Ident id -> id.idRange + | _ -> e.Range /// Attempt to get the range of the first token or initial portion only - this is extremely ad-hoc, just a cheap way to improve a certain 'query custom operation' error range member e.RangeOfFirstPortion = match e with - // haven't bothered making these cases better than just .Range - | SynExpr.Quote (range=m) - | SynExpr.Const (range=m) - | SynExpr.Typed (range=m) - | SynExpr.Tuple (range=m) - | SynExpr.ArrayOrList (range=m) - | SynExpr.AnonRecd (range=m) - | SynExpr.Record (range=m) - | SynExpr.New (range=m) - | SynExpr.ObjExpr (range=m) - | SynExpr.While (range=m) - | SynExpr.For (range=m) - | SynExpr.CompExpr (range=m) - | SynExpr.ArrayOrListOfSeqExpr (range=m) - | SynExpr.Lambda (range=m) - | SynExpr.Match (range=m) - | SynExpr.MatchLambda (range=m) - | SynExpr.Do (range=m) - | SynExpr.Assert (range=m) - | SynExpr.TypeApp (range=m) - | SynExpr.LetOrUse (range=m) - | SynExpr.TryWith (range=m) - | SynExpr.TryFinally (range=m) - | SynExpr.ArbitraryAfterError (range=m) - | SynExpr.FromParseError (range=m) - | SynExpr.DiscardAfterMissingQualificationAfterDot (range=m) - | SynExpr.IfThenElse (range=m) - | SynExpr.LongIdent (range=m) - | SynExpr.LongIdentSet (range=m) - | SynExpr.NamedIndexedPropertySet (range=m) - | SynExpr.DotIndexedGet (range=m) - | SynExpr.DotIndexedSet (range=m) - | SynExpr.DotGet (range=m) - | SynExpr.DotSet (range=m) - | SynExpr.Set (range=m) - | SynExpr.DotNamedIndexedPropertySet (range=m) - | SynExpr.LibraryOnlyUnionCaseFieldGet (range=m) - | SynExpr.LibraryOnlyUnionCaseFieldSet (range=m) - | SynExpr.LibraryOnlyILAssembly (range=m) - | SynExpr.LibraryOnlyStaticOptimization (range=m) - | SynExpr.TypeTest (range=m) - | SynExpr.Upcast (range=m) - | SynExpr.AddressOf (range=m) - | SynExpr.Downcast (range=m) - | SynExpr.JoinIn (range=m) - | SynExpr.InferredUpcast (range=m) - | SynExpr.InferredDowncast (range=m) - | SynExpr.Null (range=m) - | SynExpr.Lazy (range=m) - | SynExpr.TraitCall (range=m) - | SynExpr.ImplicitZero (range=m) - | SynExpr.YieldOrReturn (range=m) - | SynExpr.YieldOrReturnFrom (range=m) - | SynExpr.LetOrUseBang (range=m) - | SynExpr.MatchBang (range=m) - | SynExpr.DoBang (range=m) -> m // these are better than just .Range, and also commonly applicable inside queries | SynExpr.Paren (_, m, _, _) -> m | SynExpr.Sequential (_, _, e1, _, _) + | SynExpr.SequentialOrImplicitYield (_, e1, _, _, _) | SynExpr.App (_, _, e1, _, _) -> e1.RangeOfFirstPortion | SynExpr.ForEach (_, _, _, pat, _, _, r) -> let start = r.Start let e = (pat.Range: range).Start mkRange r.FileName start e - | SynExpr.Ident id -> id.idRange - | SynExpr.Fixed (_, m) -> m + | _ -> e.Range and [] @@ -1972,36 +1863,51 @@ let PushCurriedPatternsToExpr synArgNameGenerator wholem isMember pats rhs = expr spatsl, expr -/// Helper for parsing the inline IL fragments. +let internal internalParseAssemblyCodeInstructions s isFeatureSupported m = #if NO_INLINE_IL_PARSER -let ParseAssemblyCodeInstructions _s m = + ignore s + ignore isFeatureSupported + errorR(Error((193, "Inline IL not valid in a hosted environment"), m)) [| |] #else -let ParseAssemblyCodeInstructions s m = - try FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilInstrs + try + FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilInstrs FSharp.Compiler.AbstractIL.Internal.AsciiLexer.token - (UnicodeLexing.StringAsLexbuf s) + (UnicodeLexing.StringAsLexbuf(isFeatureSupported, s)) with _ -> - errorR(Error(FSComp.SR.astParseEmbeddedILError(), m)); [| |] + errorR(Error(FSComp.SR.astParseEmbeddedILError(), m)); [||] #endif +let ParseAssemblyCodeInstructions s m = + // Public API can not answer the isFeatureSupported questions, so here we support everything + let isFeatureSupported (_featureId:LanguageFeature) = true + internalParseAssemblyCodeInstructions s isFeatureSupported m + +let internal internalParseAssemblyCodeType s isFeatureSupported m = + ignore s + ignore isFeatureSupported -/// Helper for parsing the inline IL fragments. #if NO_INLINE_IL_PARSER -let ParseAssemblyCodeType _s m = errorR(Error((193, "Inline IL not valid in a hosted environment"), m)) IL.EcmaMscorlibILGlobals.typ_Object #else -let ParseAssemblyCodeType s m = - try FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilType + let isFeatureSupported (_featureId:LanguageFeature) = true + try + FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilType FSharp.Compiler.AbstractIL.Internal.AsciiLexer.token - (UnicodeLexing.StringAsLexbuf s) + (UnicodeLexing.StringAsLexbuf(isFeatureSupported, s)) with RecoverableParseError -> errorR(Error(FSComp.SR.astParseEmbeddedILTypeError(), m)); IL.EcmaMscorlibILGlobals.typ_Object #endif +/// Helper for parsing the inline IL fragments. +let ParseAssemblyCodeType s m = + // Public API can not answer the isFeatureSupported questions, so here we support everything + let isFeatureSupported (_featureId:LanguageFeature) = true + internalParseAssemblyCodeType s isFeatureSupported m + //------------------------------------------------------------------------ // AST constructors //------------------------------------------------------------------------ @@ -2564,6 +2470,8 @@ let rec synExprContainsError inpExpr = walkExpr e1 || walkExpr e2 | SynExpr.Sequential (_, _, e1, e2, _) -> walkExpr e1 || walkExpr e2 + | SynExpr.SequentialOrImplicitYield (_, e1, e2, _, _) -> + walkExpr e1 || walkExpr e2 | SynExpr.IfThenElse (e1, e2, e3opt, _, _, _, _) -> walkExpr e1 || walkExpr e2 || walkExprOpt e3opt | SynExpr.DotIndexedGet (e1, es, _, _) -> diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 7799d409e5..dc5777cdc3 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -34,8 +34,8 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.IlxGen +open FSharp.Compiler.IlxGen open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.Ast @@ -496,11 +496,10 @@ module BinaryGenerationUtilities = for _ in 1..(4 - (initialAlignment + v.Length) % 4) % 4 do yield 0x0uy |] -// Generate nodes in a .res file format. These are then linked by Abstract IL using the -// linkNativeResources function, which invokes the cvtres.exe utility -module ResFileFormat = +// Generate nodes in a .res file format. These are then linked by Abstract IL using linkNativeResources +module ResFileFormat = open BinaryGenerationUtilities - + let ResFileNode(dwTypeID, dwNameID, wMemFlags, wLangID, data: byte[]) = [| yield! i32 data.Length // DWORD ResHdr.dwDataSize yield! i32 0x00000020 // dwHeaderSize @@ -870,11 +869,9 @@ module MainModuleBuilder = error(Error(FSComp.SR.fscAssemblyCultureAttributeError(), rangeCmdArgs)) // Add the type forwarders to any .NET DLL post-.NET-2.0, to give binary compatibility - let exportedTypesList = - if (tcConfig.compilingFslib && tcConfig.compilingFslib40) then - (List.append (createMscorlibExportList tcGlobals) - (if tcConfig.compilingFslibNoBigInt then [] else (createSystemNumericsExportList tcConfig tcImports)) - ) + let exportedTypesList = + if tcConfig.compilingFslib then + List.append (createMscorlibExportList tcGlobals) (createSystemNumericsExportList tcConfig tcImports) else [] @@ -1066,13 +1063,10 @@ module MainModuleBuilder = elif not(tcConfig.target.IsExe) || not(tcConfig.includewin32manifest) || not(tcConfig.win32res = "") || runningOnMono then "" // otherwise, include the default manifest else -#if FX_NO_RUNTIMEENVIRONMENT - // On coreclr default manifest is alongside the compiler - Path.Combine(System.AppContext.BaseDirectory, @"default.win32manifest") -#else - // On the desktop default manifest is alongside the clr - Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), @"default.win32manifest") -#endif + let path = Path.Combine(System.AppContext.BaseDirectory, @"default.win32manifest") + if File.Exists(path) then path + else Path.Combine(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), @"default.win32manifest") + let nativeResources = [ for av in assemblyVersionResources findAttribute assemblyVersion do yield ILNativeResource.Out av @@ -1109,13 +1103,80 @@ module MainModuleBuilder = //---------------------------------------------------------------------------- /// Optional static linking of all DLLs that depend on the F# Library, plus other specified DLLs -module StaticLinker = +module StaticLinker = + + open FSharp.Compiler.AbstractIL + + // Handles TypeForwarding for the generated IL model + type TypeForwarding (tcImports: TcImports) = + + // Make a dictionary of ccus passed to the compiler will be looked up by qualified assembly name + let ccuThunksQualifiedName = + tcImports.GetCcusInDeclOrder() + |> List.filter(fun ccuThunk -> ccuThunk.QualifiedName |> Option.isSome) + |> List.map(fun ccuThunk -> ccuThunk.QualifiedName |> Option.defaultValue "Assembly Name Not Passed", ccuThunk) + |> dict + + // If we can't type forward using exact assembly match, we need to rely on the loader (Policy, Configuration or the coreclr load heuristics), so use try simple name + let ccuThunksSimpleName = + tcImports.GetCcusInDeclOrder() + |> List.filter(fun ccuThunk -> not (String.IsNullOrEmpty(ccuThunk.AssemblyName))) + |> List.map(fun ccuThunk -> ccuThunk.AssemblyName, ccuThunk) + |> dict + + let followTypeForwardForILTypeRef (tref:ILTypeRef) = + let typename = + let parts = tref.FullName.Split([|'.'|]) + match parts.Length with + | 0 -> None + | 1 -> Some (Array.empty, parts.[0]) + | n -> Some (parts.[0..n-2], parts.[n-1]) + + let scoref = tref.Scope + match scoref with + | ILScopeRef.Assembly scope -> + match ccuThunksQualifiedName.TryGetValue(scope.QualifiedName) with + | true, ccu -> + match typename with + | Some (parts, name) -> + let forwarded = ccu.TryForward(parts, name) + let result = + match forwarded with + | Some fwd -> fwd.CompilationPath.ILScopeRef + | None -> scoref + result + | None -> scoref + | false, _ -> + // Couldn't find an assembly with the version so try using a simple name + match ccuThunksSimpleName.TryGetValue(scope.Name) with + | true, ccu -> + match typename with + | Some (parts, name) -> + let forwarded = ccu.TryForward(parts, name) + let result = + match forwarded with + | Some fwd -> fwd.CompilationPath.ILScopeRef + | None -> scoref + result + | None -> scoref + | false, _ -> scoref + | _ -> scoref + + let typeForwardILTypeRef (tref: ILTypeRef) = + let scoref1 = tref.Scope + let scoref2 = followTypeForwardForILTypeRef tref + if scoref1 === scoref2 then tref + else ILTypeRef.Create (scoref2, tref.Enclosing, tref.Name) + + member __.TypeForwardILTypeRef tref = typeForwardILTypeRef tref + let debugStaticLinking = condition "FSHARP_DEBUG_STATIC_LINKING" - let StaticLinkILModules (tcConfig, ilGlobals, ilxMainModule, dependentILModules: (CcuThunk option * ILModuleDef) list) = + let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule, dependentILModules: (CcuThunk option * ILModuleDef) list) = if isNil dependentILModules then ilxMainModule, (fun x -> x) else + let typeForwarding = new TypeForwarding(tcImports) // Check no dependent assemblies use quotations let dependentCcuUsingQuotations = dependentILModules |> List.tryPick (function (Some ccu, _) when ccu.UsesFSharp20PlusQuotations -> Some ccu | _ -> None) @@ -1201,74 +1262,18 @@ module StaticLinker = (mkILMethods (topTypeDefs |> List.collect (fun td -> td.Methods.AsList)), mkILFields (topTypeDefs |> List.collect (fun td -> td.Fields.AsList))) - let ilxMainModule = - { ilxMainModule with - Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (m.CustomAttrs.AsList @ savedManifestAttrs)) }) - CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsArray ]) - TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs) - Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList) - NativeResources = savedNativeResources } + let ilxMainModule = + let main = + { ilxMainModule with + Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (m.CustomAttrs.AsList @ savedManifestAttrs)) }) + CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsArray ]) + TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs) + Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList) + NativeResources = savedNativeResources } + Morphs.morphILTypeRefsInILModuleMemoized ilGlobals typeForwarding.TypeForwardILTypeRef main ilxMainModule, rewriteExternalRefsToLocalRefs - - // LEGACY: This is only used when compiling an FSharp.Core for .NET 2.0 (FSharp.Core 2.3.0.0). We no longer - // build new FSharp.Core for that configuration. - // - // Find all IL modules that are to be statically linked given the static linking roots. - let LegacyFindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibraryForNet20 (tcConfig: TcConfig, ilGlobals: ILGlobals, ilxMainModule) = - let mscorlib40 = tcConfig.compilingFslib20.Value - - let ilBinaryReader = - let ilGlobals = mkILGlobals ILScopeRef.Local - let opts : ILReaderOptions = - { ilGlobals = ilGlobals - reduceMemoryUsage = tcConfig.reduceMemoryUsage - metadataOnly = MetadataOnlyFlag.No - tryGetMetadataSnapshot = (fun _ -> None) - pdbDirPath = None } - ILBinaryReader.OpenILModuleReader mscorlib40 opts - - let tdefs1 = ilxMainModule.TypeDefs.AsList |> List.filter (fun td -> not (MainModuleBuilder.injectedCompatTypes.Contains(td.Name))) - let tdefs2 = ilBinaryReader.ILModuleDef.TypeDefs.AsList |> List.filter (fun td -> MainModuleBuilder.injectedCompatTypes.Contains(td.Name)) - //printfn "tdefs2 = %A" (tdefs2 |> List.map (fun tdef -> tdef.Name)) - - // rewrite the mscorlib references - let tdefs2 = - let fakeModule = mkILSimpleModule "" "" true (4, 0) false (mkILTypeDefs tdefs2) None None 0 (mkILExportedTypes []) "" - let fakeModule = - fakeModule |> Morphs.morphILTypeRefsInILModuleMemoized ilGlobals (fun tref -> - if MainModuleBuilder.injectedCompatTypes.Contains(tref.Name) || (tref.Enclosing |> List.exists (fun x -> MainModuleBuilder.injectedCompatTypes.Contains x)) then - tref - //|> Morphs.morphILScopeRefsInILTypeRef (function ILScopeRef.Local -> ilGlobals.mscorlibScopeRef | x -> x) - // The implementations of Tuple use two private methods from System.Environment to get a resource string. Remap it - elif tref.Name = "System.Environment" then - ILTypeRef.Create(ILScopeRef.Local, [], "Microsoft.FSharp.Core.PrivateEnvironment") //|> Morphs.morphILScopeRefsInILTypeRef (function ILScopeRef.Local -> ilGlobals.mscorlibScopeRef | x -> x) - else - tref |> Morphs.morphILScopeRefsInILTypeRef (fun _ -> ilGlobals.primaryAssemblyScopeRef) ) - - // strip out System.Runtime.TargetedPatchingOptOutAttribute, which doesn't exist for 2.0 - let fakeModule = - {fakeModule with - TypeDefs = - mkILTypeDefs - ([ for td in fakeModule.TypeDefs do - let meths = td.Methods.AsList - |> List.map (fun md -> - md.With(customAttrs = - mkILCustomAttrs (td.CustomAttrs.AsList |> List.filter (fun ilattr -> - ilattr.Method.DeclaringType.TypeRef.FullName <> "System.Runtime.TargetedPatchingOptOutAttribute")))) - |> mkILMethods - let td = td.With(methods=meths) - yield td.With(methods=meths) ])} - //ILAsciiWriter.output_module stdout fakeModule - fakeModule.TypeDefs.AsList - - let ilxMainModule = - { ilxMainModule with - TypeDefs = mkILTypeDefs (tdefs1 @ tdefs2) } - ilxMainModule - [] type Node = { name: string @@ -1413,7 +1418,7 @@ module StaticLinker = let StaticLink (ctok, tcConfig: TcConfig, tcImports: TcImports, ilGlobals: ILGlobals) = #if !NO_EXTENSIONTYPING - let providerGeneratedAssemblies = + let providerGeneratedAssemblies = [ // Add all EST-generated assemblies into the static linking set for KeyValue(_, importedBinary: ImportedBinary) in tcImports.DllTable do @@ -1422,10 +1427,7 @@ module StaticLinker = | None -> () | Some provAssemStaticLinkInfo -> yield (importedBinary, provAssemStaticLinkInfo) ] #endif - if tcConfig.compilingFslib && tcConfig.compilingFslib20.IsSome then - (fun ilxMainModule -> LegacyFindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibraryForNet20 (tcConfig, ilGlobals, ilxMainModule)) - - elif not tcConfig.standalone && tcConfig.extraStaticLinkRoots.IsEmpty + if not tcConfig.standalone && tcConfig.extraStaticLinkRoots.IsEmpty #if !NO_EXTENSIONTYPING && providerGeneratedAssemblies.IsEmpty #endif @@ -1578,8 +1580,8 @@ module StaticLinker = // Glue all this stuff into ilxMainModule let ilxMainModule, rewriteExternalRefsToLocalRefs = - StaticLinkILModules (tcConfig, ilGlobals, ilxMainModule, dependentILModules @ providerGeneratedILModules) - + StaticLinkILModules (tcConfig, ilGlobals, tcImports, ilxMainModule, dependentILModules @ providerGeneratedILModules) + // Rewrite type and assembly references let ilxMainModule = let isMscorlib = ilGlobals.primaryAssemblyName = PrimaryAssembly.Mscorlib.Name @@ -1706,25 +1708,19 @@ let main0(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, exiter: Exiter, errorLoggerProvider : ErrorLoggerProvider, disposables : DisposablesTracker) = // See Bug 735819 - let lcidFromCodePage = -#if FX_LCIDFROMCODEPAGE + let lcidFromCodePage = if (Console.OutputEncoding.CodePage <> 65001) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then Thread.CurrentThread.CurrentUICulture <- new CultureInfo("en-US") Some 1033 else -#endif None let directoryBuildingFrom = Directory.GetCurrentDirectory() let setProcessThreadLocals tcConfigB = match tcConfigB.preferredUiLang with -#if FX_RESHAPED_GLOBALIZATION - | Some s -> CultureInfo.CurrentUICulture <- new CultureInfo(s) -#else | Some s -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(s) -#endif | None -> () if tcConfigB.utf8output then Console.OutputEncoding <- Encoding.UTF8 diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 02b26bf9af..99bffe0b73 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -27,13 +27,14 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Extensions.ILX -open FSharp.Compiler.AbstractIL.ILRuntimeWriter +open FSharp.Compiler.AbstractIL.ILRuntimeWriter open FSharp.Compiler.Lib open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Ast open FSharp.Compiler.CompileOptions open FSharp.Compiler.CompileOps open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution @@ -389,9 +390,7 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals, | PrintExpr -> anyToLayoutCall.AnyToLayout(opts, x, ty) with -#if !FX_REDUCED_EXCEPTIONS | :? ThreadAbortException -> Layout.wordL (TaggedTextOps.tagText "") -#endif | e -> #if DEBUG printf "\n\nPrintValue: x = %+A and ty=%s\n" x (ty.FullName) @@ -787,14 +786,12 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s member __.Gui = gui /// Set the current ui culture for the current thread. -#if FX_LCIDFROMCODEPAGE let internal SetCurrentUICultureForThread (lcid : int option) = let culture = Thread.CurrentThread.CurrentUICulture match lcid with | Some n -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(n) | None -> () { new IDisposable with member x.Dispose() = Thread.CurrentThread.CurrentUICulture <- culture } -#endif //---------------------------------------------------------------------------- // Reporting - warnings, errors @@ -805,7 +802,6 @@ let internal InstallErrorLoggingOnThisThread errorLogger = SetThreadErrorLoggerNoUnwind(errorLogger) SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive) -#if !FX_NO_SERVERCODEPAGES /// Set the input/output encoding. The use of a thread is due to a known bug on /// on Vista where calls to Console.InputEncoding can block the process. let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = @@ -835,7 +831,6 @@ let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = if not !successful then System.Windows.Forms.MessageBox.Show(FSIstrings.SR.fsiConsoleProblem()) |> ignore #endif -#endif //---------------------------------------------------------------------------- // Prompt printing @@ -964,6 +959,8 @@ type internal FsiDynamicCompiler let outfile = "TMPFSCI.exe" let assemblyName = "FSI-ASSEMBLY" + let assemblyReferenceAddedEvent = Control.Event() + let mutable fragmentId = 0 let mutable prevIt : ValRef option = None @@ -1247,7 +1244,7 @@ type internal FsiDynamicCompiler let tcState = istate.tcState let tcEnv,(_dllinfos,ccuinfos) = try - RequireDLL (ctok, tcImports, tcState.TcEnvFromImpls, assemblyName, m, path) + RequireDLL (ctok, tcImports, tcState.TcEnvFromImpls, assemblyName, m, path, assemblyReferenceAddedEvent.Trigger) with e -> tcConfigB.RemoveReferencedAssemblyByPath(m,path) reraise() @@ -1336,22 +1333,20 @@ type internal FsiDynamicCompiler member __.FormatValue(obj:obj, objTy) = valuePrinter.FormatValue(obj, objTy) + member __.AssemblyReferenceAdded = assemblyReferenceAddedEvent.Publish //---------------------------------------------------------------------------- // ctrl-c handling //---------------------------------------------------------------------------- -module internal NativeMethods = - - type ControlEventHandler = delegate of int -> bool +type ControlEventHandler = delegate of int -> bool - [] - extern bool SetConsoleCtrlHandler(ControlEventHandler _callback,bool _add) // One strange case: when a TAE happens a strange thing // occurs the next read from stdin always returns // 0 bytes, i.e. the channel will look as if it has been closed. So we check // for this condition explicitly. We also recreate the lexbuf whenever CtrlC kicks. + type internal FsiInterruptStdinState = | StdinEOFPermittedBecauseCtrlCRecentlyPressed | StdinNormal @@ -1366,149 +1361,74 @@ type internal FsiInterruptControllerKillerThreadRequest = | ExitRequest | PrintInterruptRequest -type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, - fsiConsoleOutput: FsiConsoleOutput) = +type internal FsiInterruptController(fsiOptions: FsiCommandLineOptions, fsiConsoleOutput: FsiConsoleOutput) = let mutable stdinInterruptState = StdinNormal let CTRL_C = 0 let mutable interruptAllowed = InterruptIgnored let mutable killThreadRequest = NoRequest - let mutable ctrlEventHandlers = [] : NativeMethods.ControlEventHandler list - let mutable ctrlEventActions = [] : (unit -> unit) list + + let mutable ctrlEventHandlers = []: ControlEventHandler list + let mutable ctrlEventActions = []: (unit -> unit) list let mutable exitViaKillThread = false let mutable posixReinstate = (fun () -> ()) - member __.Exit() = - if exitViaKillThread then + member __.Exit() = + if exitViaKillThread then killThreadRequest <- ExitRequest Thread.Sleep(1000) exit 0 - member __.FsiInterruptStdinState with get () = stdinInterruptState and set v = stdinInterruptState <- v + member __.FsiInterruptStdinState + with get () = stdinInterruptState + and set v = stdinInterruptState <- v member __.ClearInterruptRequest() = killThreadRequest <- NoRequest - - member __.InterruptAllowed with set v = interruptAllowed <- v - + + member __.InterruptAllowed + with set v = interruptAllowed <- v + member __.Interrupt() = ctrlEventActions |> List.iter (fun act -> act()) - + member __.EventHandlers = ctrlEventHandlers - // REVIEW: streamline all this code to use the same code on Windows and Posix. - member controller.InstallKillThread(threadToKill:Thread, pauseMilliseconds:int) = -#if DYNAMIC_CODE_EMITS_INTERRUPT_CHECKS - let action() = - Microsoft.FSharp.Silverlight.InterruptThread(threadToKill.ManagedThreadId) + member controller.InstallKillThread(threadToKill:Thread, pauseMilliseconds:int) = - ctrlEventActions <- action :: ctrlEventActions; -#else -#if FX_NO_THREADABORT - ignore threadToKill - ignore pauseMilliseconds - ignore fsiConsoleOutput - ignore CTRL_C - ignore fsiOptions - exitViaKillThread <- false -#else - if !progress then fprintfn fsiConsoleOutput.Out "installing CtrlC handler" - // WINDOWS TECHNIQUE: .NET has more safe points, and you can do more when a safe point. - // Hence we actually start up the killer thread within the handler. - try - let raiseCtrlC() = -#if FX_LCIDFROMCODEPAGE - use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#else - ignore fsiOptions -#endif - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()) - stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed - if (interruptAllowed = InterruptCanRaiseException) then - killThreadRequest <- ThreadAbortRequest - let killerThread = - new Thread(new ThreadStart(fun () -> -#if FX_LCIDFROMCODEPAGE - use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif - // sleep long enough to allow ControlEventHandler handler on main thread to return - // Also sleep to give computations a bit of time to terminate - Thread.Sleep(pauseMilliseconds) - if (killThreadRequest = ThreadAbortRequest) then - if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) - killThreadRequest <- NoRequest - threadToKill.Abort() - ()),Name="ControlCAbortThread") - killerThread.IsBackground <- true - killerThread.Start() - - let ctrlEventHandler = new NativeMethods.ControlEventHandler(fun i -> if i = CTRL_C then (raiseCtrlC(); true) else false ) - ctrlEventHandlers <- ctrlEventHandler :: ctrlEventHandlers - ctrlEventActions <- raiseCtrlC :: ctrlEventActions - let _resultOK = NativeMethods.SetConsoleCtrlHandler(ctrlEventHandler,true) - exitViaKillThread <- false // don't exit via kill thread - with e -> - if !progress then fprintfn fsiConsoleOutput.Error "Failed to install ctrl-c handler using Windows technique - trying to install one using Unix signal handling..."; - // UNIX TECHNIQUE: We start up a killer thread, and it watches the mutable reference location. - // We can't have a dependency on Mono DLLs (indeed we don't even have them!) - // So SOFT BIND the following code: - // Mono.Unix.Native.Stdlib.signal(Mono.Unix.Native.Signum.SIGINT,new Mono.Unix.Native.SignalHandler(fun n -> PosixSignalProcessor.PosixInvoke(n))) |> ignore; - match (try Choice1Of2(Assembly.Load(new System.Reflection.AssemblyName("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756"))) with e -> Choice2Of2 e) with - | Choice1Of2(monoPosix) -> - try - if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.Stdlib..." - let monoUnixStdlib = monoPosix.GetType("Mono.Unix.Native.Stdlib") - if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.SignalHandler..." - let monoUnixSignalHandler = monoPosix.GetType("Mono.Unix.Native.SignalHandler") - if !progress then fprintfn fsiConsoleOutput.Error "creating delegate..." - controller.PosixInvoke(-1) - let monoHandler = System.Delegate.CreateDelegate(monoUnixSignalHandler,controller,"PosixInvoke") - if !progress then fprintfn fsiConsoleOutput.Error "registering signal handler..." - let monoSignalNumber = System.Enum.Parse(monoPosix.GetType("Mono.Unix.Native.Signum"),"SIGINT") - let register () = Utilities.callStaticMethod monoUnixStdlib "signal" [ monoSignalNumber; box monoHandler ] |> ignore - posixReinstate <- register - register() + // Fsi Interupt handler + let raiseCtrlC() = + use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID + fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()) + + stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed + if (interruptAllowed = InterruptCanRaiseException) then + killThreadRequest <- ThreadAbortRequest let killerThread = new Thread(new ThreadStart(fun () -> -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif - while true do - //fprintf fsiConsoleOutput.Error "\n- kill thread loop...\n"; errorWriter.Flush(); - Thread.Sleep(pauseMilliseconds*2) - match killThreadRequest with - | PrintInterruptRequest -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush() - killThreadRequest <- NoRequest - | ThreadAbortRequest -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush() - if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) - killThreadRequest <- NoRequest - threadToKill.Abort() - | ExitRequest -> - // Mono has some weird behaviour where it blocks on exit - // once CtrlC has ever been pressed. Who knows why? Perhaps something - // to do with having a signal handler installed, but it only happens _after_ - // at least one CtrLC has been pressed. Maybe raising a ThreadAbort causes - // exiting to have problems. - // - // Anyway, we make "#q" work this case by setting ExitRequest and brutally calling - // the process-wide 'exit' - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiExit()); fsiConsoleOutput.Error.Flush() - Utilities.callStaticMethod monoUnixStdlib "exit" [ box 0 ] |> ignore - | _ -> () - done),Name="ControlCAbortAlternativeThread") + // sleep long enough to allow ControlEventHandler handler on main thread to return + // Also sleep to give computations a bit of time to terminate + Thread.Sleep(pauseMilliseconds) + if (killThreadRequest = ThreadAbortRequest) then + if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) + killThreadRequest <- NoRequest + threadToKill.Abort() + ()),Name="ControlCAbortThread") killerThread.IsBackground <- true killerThread.Start() - // exit via kill thread to workaround block-on-exit bugs with Mono once a CtrlC has been pressed - exitViaKillThread <- true - with e -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiCouldNotInstallCtrlCHandler(e.Message)) - exitViaKillThread <- false - | Choice2Of2 e -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiCouldNotInstallCtrlCHandler(e.Message)) - exitViaKillThread <- false -#endif + let fsiInterruptHandler (args:ConsoleCancelEventArgs) = + args.Cancel <- true + ctrlEventHandlers |> List.iter(fun handler -> handler.Invoke(CTRL_C) |> ignore) + + do Console.CancelKeyPress.Add(fsiInterruptHandler) + + // WINDOWS TECHNIQUE: .NET has more safe points, and you can do more when a safe point. + // Hence we actually start up the killer thread within the handler. + let ctrlEventHandler = new ControlEventHandler(fun i -> if i = CTRL_C then (raiseCtrlC(); true) else false ) + ctrlEventHandlers <- ctrlEventHandler :: ctrlEventHandlers + ctrlEventActions <- raiseCtrlC :: ctrlEventActions + exitViaKillThread <- false // don't exit via kill thread member x.PosixInvoke(n:int) = // we run this code once with n = -1 to make sure it is JITted before execution begins @@ -1519,8 +1439,6 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed killThreadRequest <- if (interruptAllowed = InterruptCanRaiseException) then ThreadAbortRequest else PrintInterruptRequest -#endif - //---------------------------------------------------------------------------- // assembly finder //---------------------------------------------------------------------------- @@ -1577,22 +1495,14 @@ module internal MagicAssemblyResolution = let Install(tcConfigB, tcImports: TcImports, fsiDynamicCompiler: FsiDynamicCompiler, fsiConsoleOutput: FsiConsoleOutput) = -#if NETSTANDARD - ignore tcConfigB - ignore tcImports - ignore fsiDynamicCompiler - ignore fsiConsoleOutput - { new System.IDisposable with - member x.Dispose() = () } -#else let ResolveAssembly (ctok, m, tcConfigB, tcImports: TcImports, fsiDynamicCompiler: FsiDynamicCompiler, fsiConsoleOutput: FsiConsoleOutput, fullAssemName:string) = try // Grab the name of the assembly let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let simpleAssemName = fullAssemName.Split([| ',' |]).[0] + let simpleAssemName = fullAssemName.Split([| ',' |]).[0] if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON ASSEMBLY, simpleAssemName = %s" simpleAssemName // "Attempting to load a dynamically required assembly in response to an AssemblyResolve event by using known static assembly references..." - + // Special case: Mono Windows Forms attempts to load an assembly called something like "Windows.Forms.resources" // We can't resolve this, so don't try. // REVIEW: Suggest 4481, delete this special case. @@ -1608,7 +1518,7 @@ module internal MagicAssemblyResolution = // Otherwise continue let assemblyReferenceTextDll = (simpleAssemName + ".dll") let assemblyReferenceTextExe = (simpleAssemName + ".exe") - let overallSearchResult = + let overallSearchResult = // OK, try to resolve as an existing DLL in the resolved reference set. This does unification by assembly name // once an assembly has been referenced. @@ -1652,15 +1562,15 @@ module internal MagicAssemblyResolution = | Some(assembly) -> OkResult([],Choice2Of2 assembly) | None -> #endif - + // As a last resort, try to find the reference without an extension match tcImports.TryFindExistingFullyQualifiedPathByExactAssemblyRef(ctok, ILAssemblyRef.Create(simpleAssemName,None,None,false,None,None)) with | Some(resolvedPath) -> OkResult([],Choice1Of2 resolvedPath) | None -> - + ErrorResult([],Failure (FSIstrings.SR.fsiFailedToResolveAssembly(simpleAssemName))) - + match overallSearchResult with | ErrorResult _ -> null | OkResult _ -> @@ -1671,8 +1581,8 @@ module internal MagicAssemblyResolution = assemblyLoadFrom assemblyName | Choice2Of2 assembly -> assembly - - with e -> + + with e -> stopProcessingRecovery e range0 null @@ -1683,12 +1593,11 @@ module internal MagicAssemblyResolution = // during compilation. So we recover the CompilationThreadToken here. let ctok = AssumeCompilationThreadWithoutEvidence () ResolveAssembly (ctok, rangeStdin, tcConfigB, tcImports, fsiDynamicCompiler, fsiConsoleOutput, args.Name)) - + AppDomain.CurrentDomain.add_AssemblyResolve(handler) { new System.IDisposable with member x.Dispose() = AppDomain.CurrentDomain.remove_AssemblyResolve(handler) } -#endif //---------------------------------------------------------------------------- // Reading stdin @@ -1706,9 +1615,11 @@ type internal FsiStdinLexerProvider let initialLightSyntaxStatus = tcConfigB.light <> Some false LightSyntaxStatus (initialLightSyntaxStatus, false (* no warnings *)) + let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId + let LexbufFromLineReader (fsiStdinSyphon: FsiStdinSyphon) readf = - UnicodeLexing.FunctionAsLexbuf - (fun (buf: char[], start, len) -> + UnicodeLexing.FunctionAsLexbuf + (isFeatureSupported, (fun (buf: char[], start, len) -> //fprintf fsiConsoleOutput.Out "Calling ReadLine\n" let inputOption = try Some(readf()) with :? EndOfStreamException -> None inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add (t + "\n")) @@ -1724,7 +1635,7 @@ type internal FsiStdinLexerProvider for i = 0 to ntrimmed-1 do buf.[i+start] <- input.[i] ntrimmed - ) + )) //---------------------------------------------------------------------------- // Reading stdin as a lex stream @@ -1745,6 +1656,7 @@ type internal FsiStdinLexerProvider let tokenizer = LexFilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf) tokenizer + let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId // Create a new lexer to read stdin member __.CreateStdinLexer (errorLogger) = @@ -1763,12 +1675,12 @@ type internal FsiStdinLexerProvider // Create a new lexer to read an "included" script file member __.CreateIncludedScriptLexer (sourceFileName, errorLogger) = - let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(sourceFileName,tcConfigB.inputCodePage,(*retryLocked*)false) + let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(isFeatureSupported, sourceFileName, tcConfigB.inputCodePage, (*retryLocked*)false) CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) // Create a new lexer to read a string member this.CreateStringLexer (sourceFileName, source, errorLogger) = - let lexbuf = UnicodeLexing.StringAsLexbuf(source) + let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, source) CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) member __.ConsoleInput = fsiConsoleInput @@ -1809,9 +1721,7 @@ type internal FsiInteractionProcessor // FSI error logging on switched to thread InstallErrorLoggingOnThisThread errorLogger -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif f ctok istate) with _ -> (istate,Completed None) @@ -1828,6 +1738,7 @@ type internal FsiInteractionProcessor stopProcessingRecovery e range0 istate,CompletedWithReportedError e + let isFeatureSupported featureId = tcConfigB.langVersion.SupportsFeature featureId let rangeStdin = rangeN Lexhelp.stdinMockFilename 0 @@ -2034,13 +1945,11 @@ type internal FsiInteractionProcessor fsiInterruptController.InterruptAllowed <- InterruptIgnored; res with -#if !FX_REDUCED_EXCEPTIONS | :? ThreadAbortException -> fsiInterruptController.ClearInterruptRequest() fsiInterruptController.InterruptAllowed <- InterruptIgnored; (try Thread.ResetAbort() with _ -> ()); (istate,CtrlC) -#endif | e -> fsiInterruptController.ClearInterruptRequest() fsiInterruptController.InterruptAllowed <- InterruptIgnored; @@ -2054,11 +1963,7 @@ type internal FsiInteractionProcessor let parseExpression (tokenizer:LexFilter.LexFilter) = reusingLexbufForParsing tokenizer.LexBuffer (fun () -> Parser.typedSeqExprEOF tokenizer.Lexer tokenizer.LexBuffer) - -// let parseType (tokenizer:LexFilter.LexFilter) = -// reusingLexbufForParsing tokenizer.LexBuffer (fun () -> -// Parser.typEOF tokenizer.Lexer tokenizer.LexBuffer) - + let mainThreadProcessParsedExpression ctok errorLogger (expr, istate) = istate |> InteractiveCatch errorLogger (fun istate -> istate |> mainThreadProcessAction ctok (fun ctok _tcConfig istate -> @@ -2185,10 +2090,8 @@ type internal FsiInteractionProcessor member __.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger) = use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive) use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif - let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText) + let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) currState |> InteractiveCatch errorLogger (fun istate -> @@ -2204,10 +2107,8 @@ type internal FsiInteractionProcessor member __.EvalExpression (ctok, sourceText, scriptFileName, errorLogger) = use _unwind1 = ErrorLogger.PushThreadBuildPhaseUntilUnwind(ErrorLogger.BuildPhase.Interactive) use _unwind2 = ErrorLogger.PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif - let lexbuf = UnicodeLexing.StringAsLexbuf(sourceText) + let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) currState |> InteractiveCatch errorLogger (fun istate -> @@ -2235,9 +2136,7 @@ type internal FsiInteractionProcessor let stdinReaderThread = new Thread(new ThreadStart(fun () -> InstallErrorLoggingOnThisThread errorLogger // FSI error logging on stdinReaderThread, e.g. parse errors. -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif try try let initialTokenizer = fsiStdinLexerProvider.CreateStdinLexer(errorLogger) @@ -2341,9 +2240,7 @@ let internal SpawnInteractiveServer fsiConsoleOutput: FsiConsoleOutput) = //printf "Spawning fsi server on channel '%s'" !fsiServerName; SpawnThread "ServerThread" (fun () -> -#if FX_LCIDFROMCODEPAGE use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID -#endif try fsi.StartServer(fsiOptions.FsiServerName) with e -> @@ -2361,7 +2258,6 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO if !progress then fprintfn fsiConsoleOutput.Out "MAIN: entering event loop..."; fsi.EventLoopRun() with -#if !FX_REDUCED_EXCEPTIONS | :? ThreadAbortException -> // If this TAE handler kicks it's almost certainly too late to save the // state of the process - the state of the message loop may have been corrupted @@ -2369,7 +2265,6 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO (try Thread.ResetAbort() with _ -> ()); true // Try again, just case we can restart -#endif | e -> stopProcessingRecovery e range0; true @@ -2466,20 +2361,14 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i do match tcConfigB.preferredUiLang with -#if FX_RESHAPED_GLOBALIZATION - | Some s -> System.Globalization.CultureInfo.CurrentUICulture <- new System.Globalization.CultureInfo(s) -#else | Some s -> Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo(s) -#endif | None -> () -#if !FX_NO_SERVERCODEPAGES - do - try - SetServerCodePages fsiOptions - with e -> + do + try + SetServerCodePages fsiOptions + with e -> warning(e) -#endif do updateBannerText() // resetting banner text after parsing options @@ -2670,8 +2559,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i member x.FormatValue(obj:obj, objTy) = fsiDynamicCompiler.FormatValue(obj, objTy) - member x.EvalExpression(sourceText) = - + member x.EvalExpression(sourceText) = + // Explanation: When the user of the FsiInteractiveSession object calls this method, the // code is parsed, checked and evaluated on the calling thread. This means EvalExpression // is not safe to call concurrently. @@ -2680,7 +2569,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i fsiInteractionProcessor.EvalExpression(ctok, sourceText, dummyScriptFileName, errorLogger) |> commitResult - member x.EvalExpressionNonThrowing(sourceText) = + member x.EvalExpressionNonThrowing(sourceText) = // Explanation: When the user of the FsiInteractiveSession object calls this method, the // code is parsed, checked and evaluated on the calling thread. This means EvalExpression // is not safe to call concurrently. @@ -2709,9 +2598,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) - fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger) + fsiInteractionProcessor.EvalInteraction(ctok, sourceText, dummyScriptFileName, errorLogger) |> 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 @@ -2734,6 +2622,9 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i fsiInteractionProcessor.EvalScript(ctok, scriptPath, errorLogger) |> commitResultNonThrowing errorOptions scriptPath errorLogger |> function Choice1Of2 (_), errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs + + /// Event fires every time an assembly reference is added to the execution environment, e.g., via `#r`. + member __.AssemblyReferenceAdded = fsiDynamicCompiler.AssemblyReferenceAdded /// Performs these steps: /// - Load the dummy interaction, if any diff --git a/src/fsharp/fsi/fsi.fsi b/src/fsharp/fsi/fsi.fsi index 49c307b6cb..2897e36484 100644 --- a/src/fsharp/fsi/fsi.fsi +++ b/src/fsharp/fsi/fsi.fsi @@ -149,7 +149,7 @@ type FsiEvaluationSession = /// /// Due to a current limitation, it is not fully thread-safe to run this operation concurrently with evaluation triggered /// by input from 'stdin'. - member EvalInteractionNonThrowing : code: string -> Choice * FSharpErrorInfo[] + member EvalInteractionNonThrowing : code: string -> Choice * FSharpErrorInfo[] /// Execute the given script. Stop on first error, discarding the rest /// of the script. Errors are sent to the output writer, a 'true' return value indicates there @@ -227,6 +227,9 @@ type FsiEvaluationSession = /// A host calls this to report an unhandled exception in a standard way, e.g. an exception on the GUI thread gets printed to stderr member ReportUnhandledException : exn: exn -> unit + /// Event fires every time an assembly reference is added to the execution environment, e.g., via `#r`. + member AssemblyReferenceAdded : IEvent + /// Load the dummy interaction, load the initial files, and, /// if interacting, start the background thread to read the standard input. /// diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index dbe4296e0f..8fdd28f3b5 100755 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -478,7 +478,7 @@ and ImportILTypeDefList amap m (cpath: CompilationPath) enc items = let modty = lazy (ImportILTypeDefList amap m (cpath.NestedCompPath n Namespace) enc tgs) NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) (fun (n, info: Lazy<_>) -> - let (scoref2, _, lazyTypeDef: ILPreTypeDef) = info.Force() + let (scoref2, lazyTypeDef: ILPreTypeDef) = info.Force() ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.GetTypeDef())) let kind = match enc with [] -> Namespace | _ -> ModuleOrType @@ -489,7 +489,7 @@ and ImportILTypeDefList amap m (cpath: CompilationPath) enc items = and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = // We be very careful not to force a read of the type defs here tdefs.AsArrayOfPreTypeDefs - |> Array.map (fun pre -> (pre.Namespace, (pre.Name, notlazy(scoref, pre.MetadataIndex, pre)))) + |> Array.map (fun pre -> (pre.Namespace, (pre.Name, notlazy(scoref, pre)))) |> Array.toList |> ImportILTypeDefList amap m cpath enc @@ -519,7 +519,7 @@ let ImportILAssemblyExportedType amap m auxModLoader (scoref: ILScopeRef) (expor | None -> error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m)) | Some preTypeDef -> - scoref, -1, preTypeDef) + scoref, preTypeDef) [ ImportILTypeDefList amap m (CompPath(scoref, [])) [] [(ns, (n, info))] ] diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 71c44cdc55..e8a036febb 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -835,7 +835,15 @@ type ILMethInfo = member x.IsDllImport (g: TcGlobals) = match g.attrib_DllImportAttribute with | None -> false - | Some (AttribInfo(tref, _)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome + | Some attr -> + x.RawMetadata.CustomAttrs + |> TryFindILAttribute attr + + /// Indicates if the method is marked with the [] attribute. This is done by looking at the IL custom attributes on + /// the method. + member x.IsReadOnly (g: TcGlobals) = + x.RawMetadata.CustomAttrs + |> TryFindILAttribute g.attrib_IsReadOnlyAttribute /// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method. /// An instance extension method returns one object argument. @@ -1238,6 +1246,25 @@ type MethInfo = member x.IsStruct = isStructTy x.TcGlobals x.ApparentEnclosingType + /// Indicates if this method is read-only; usually by the [] attribute. + /// Must be an instance method. + /// Receiver must be a struct type. + member x.IsReadOnly = + // Perf Review: Is there a way we can cache this result? + x.IsInstance && + x.IsStruct && + match x with + | ILMeth (g, ilMethInfo, _) -> ilMethInfo.IsReadOnly g + | FSMeth _ -> false // F# defined methods not supported yet. Must be a language feature. + | _ -> false + + /// Indicates if this method is an extension member that is read-only. + /// An extension member is considered read-only if the first argument is a read-only byref (inref) type. + member x.IsReadOnlyExtensionMember (amap: Import.ImportMap, m) = + x.IsExtensionMember && + x.TryObjArgByrefType(amap, m, x.FormalMethodInst) + |> Option.exists (isInByrefTy amap.g) + /// Build IL method infos. static member CreateILMeth (amap: Import.ImportMap, m, ty: TType, md: ILMethodDef) = let tinfo = ILTypeInfo.FromType amap.g ty diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index c32c9a641b..a3a0003f57 100755 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -23,6 +23,7 @@ open FSharp.Compiler open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Parser open FSharp.Compiler.Lexhelp open FSharp.Compiler.Lib @@ -66,13 +67,11 @@ let get0OXB (s:string) (p:byref) l = let formatError() = raise (new System.FormatException(SR.GetString("bad format string"))) -let parseBinaryUInt64 (s:string) p l = - let rec parse n acc = if n < l then parse (n+1) (acc * 2UL + (match s.[n] with '0' -> 0UL | '1' -> 1UL | _ -> formatError())) else acc - parse p 0UL +let parseBinaryUInt64 (s:string) = + Convert.ToUInt64(s, 2) -let parseOctalUInt64 (s:string) p l = - let rec parse n acc = if n < l then parse (n+1) (acc * 8UL + (let c = s.[n] in if c >= '0' && c <= '7' then Convert.ToUInt64 c - Convert.ToUInt64 '0' else formatError())) else acc - parse p 0UL +let parseOctalUInt64 (s:string) = + Convert.ToUInt64(s, 8) let removeUnderscores (s:string) = match s with @@ -85,14 +84,10 @@ let parseInt32 (s:string) = let mutable p = 0 let sign = getSign32 s &p l let specifier = get0OXB s &p l -#if FX_RESHAPED_GLOBALIZATION - match CultureInfo.InvariantCulture.TextInfo.ToLower(specifier) with -#else match Char.ToLower(specifier,CultureInfo.InvariantCulture) with -#endif | 'x' -> sign * (int32 (Convert.ToUInt32(UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture)))) - | 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 s p l))) - | 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 s p l))) + | 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p))))) + | 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p))))) | _ -> Int32.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) let lexemeTrimRightToInt32 args lexbuf n = @@ -146,19 +141,17 @@ let tryAppendXmlDoc (buff:option) (s:string) = let shouldStartLine args lexbuf (m:range) err tok = if (m.StartColumn <> 0) then fail args lexbuf err tok else tok - + let shouldStartFile args lexbuf (m:range) err tok = if (m.StartColumn <> 0 || m.StartLine <> 1) then fail args lexbuf err tok else tok - -let evalIfDefExpression startPos args (lookup:string->bool) (lexed:string) = - let lexbuf = LexBuffer.FromChars (lexed.ToCharArray ()) + +let evalIfDefExpression startPos isFeatureSupported args (lookup:string->bool) (lexed:string) = + let lexbuf = LexBuffer.FromChars (isFeatureSupported, lexed.ToCharArray ()) lexbuf.StartPos <- startPos lexbuf.EndPos <- startPos let tokenStream = FSharp.Compiler.PPLexer.tokenstream args - let expr = FSharp.Compiler.PPParser.start tokenStream lexbuf - LexerIfdefEval lookup expr } @@ -616,7 +609,7 @@ rule token args skip = parse { let m = lexbuf.LexemeRange let lookup id = List.contains id args.defines let lexed = lexeme lexbuf - let isTrue = evalIfDefExpression lexbuf.StartPos args lookup lexed + let isTrue = evalIfDefExpression lexbuf.StartPos lexbuf.SupportsFeature args lookup lexed args.ifdefStack := (IfDefIf,m) :: !(args.ifdefStack) // Get the token; make sure it starts at zero position & return diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index dfcbddc2da..6c4599f8a1 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -513,9 +513,7 @@ module UnmanagedProcessExecutionOptions = extern UInt32 private GetLastError() // Translation of C# from http://swikb/v1/DisplayOnlineDoc.aspx?entryID=826 and copy in bug://5018 -#if !FX_NO_SECURITY_PERMISSIONS [] -#endif let EnableHeapTerminationOnCorruption() = if (System.Environment.OSVersion.Version.Major >= 6 && // If OS is Vista or higher System.Environment.Version.Major < 3) then // and CLR not 3.0 or higher diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 56e6dbfb40..cb2b0a7020 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -18,6 +18,7 @@ open FSharp.Compiler.Ast open FSharp.Compiler.Lib open FSharp.Compiler.PrettyNaming open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features #if DEBUG let debugPrint(s) = @@ -129,9 +130,11 @@ let mkDefnBindings (mWhole,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs,_bindi let attrDecls = if not (isNil freeAttrs) then [ SynModuleDecl.Attributes (freeAttrs,attrsm) ] else [] attrDecls @ letDecls -let idOfPat m p = - match p with - | SynPat.Named (SynPat.Wild _,id,false,_,_) -> id +let idOfPat (parseState:IParseState) m p = + match p with + | SynPat.Wild r when parseState.LexBuffer.SupportsFeature LanguageFeature.WildCardInForLoop -> + mkSynId r "_" + | SynPat.Named (SynPat.Wild _,id,false,_,_) -> id | SynPat.LongIdent(LongIdentWithDots([id],_),_,None, SynConstructorArgs.Pats [], None,_) -> id | _ -> raiseParseErrorAt m (FSComp.SR.parsIntegerForLoopRequiresSimpleIdentifier()) @@ -1913,8 +1916,12 @@ opt_typ: | /* EMPTY */ { None } | COLON typ { Some $2 } - atomicPatternLongIdent: + | UNDERSCORE DOT pathOp { + if not (parseState.LexBuffer.SupportsFeature LanguageFeature.SingleUnderscorePattern) then + raiseParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedSymbolDot()) + let (LongIdentWithDots(lid,dotms)) = $3 in (None,LongIdentWithDots(ident("_",rhs parseState 1)::lid, rhs parseState 2::dotms)) + } | GLOBAL DOT pathOp { let (LongIdentWithDots(lid,dotms)) = $3 in (None,LongIdentWithDots(ident(MangledGlobalName,rhs parseState 1) :: lid, rhs parseState 2 :: dotms)) } | pathOp { (None,$1) } | access pathOp { (Some($1), $2) } @@ -2106,7 +2113,7 @@ inlineAssemblyTyconRepr: | HASH stringOrKeywordString HASH { libraryOnlyError (lhs parseState) let lhsm = lhs parseState - SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (ParseAssemblyCodeType $2 (rhs parseState 2),lhsm) } + SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (internalParseAssemblyCodeType $2 parseState.LexBuffer.SupportsFeature (rhs parseState 2),lhsm) } classOrInterfaceOrStruct: | CLASS { TyconClass } @@ -2850,7 +2857,7 @@ atomicPattern: { SynPat.QuoteExpr($1,lhs parseState) } | CHAR DOT_DOT CHAR { SynPat.DeprecatedCharRange ($1,$3,rhs2 parseState 1 3) } | LBRACE recordPatternElementsAux rbrace - { let rs,m = $2 in SynPat.Record (rs,m) } + { let rs, m = $2 in SynPat.Record (rs, rhs2 parseState 1 3) } | LBRACK listPatternElements RBRACK { SynPat.ArrayOrList(false,$2,lhs parseState) } | LBRACK_BAR listPatternElements BAR_RBRACK @@ -4002,7 +4009,7 @@ forLoopBinder: forLoopRange: | parenPattern EQUALS declExpr forLoopDirection declExpr - { idOfPat (rhs parseState 1) $1,$3,$4,$5 } + { idOfPat parseState (rhs parseState 1) $1,$3,$4,$5 } | parenPattern EQUALS rangeSequenceExpr { raiseParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnexpectedSymbolEqualsInsteadOfIn()) } @@ -4015,11 +4022,11 @@ inlineAssemblyExpr: | HASH stringOrKeywordString opt_inlineAssemblyTypeArg opt_curriedArgExprs opt_inlineAssemblyReturnTypes HASH { libraryOnlyWarning (lhs parseState) let s,sm = $2,rhs parseState 2 - (fun m -> SynExpr.LibraryOnlyILAssembly (ParseAssemblyCodeInstructions s sm,$3,List.rev $4,$5,m)) } - -opt_curriedArgExprs: - | opt_curriedArgExprs argExpr %prec expr_args - { $2 :: $1 } + (fun m -> SynExpr.LibraryOnlyILAssembly (internalParseAssemblyCodeInstructions s parseState.LexBuffer.SupportsFeature sm, $3, List.rev $4, $5, m)) } + +opt_curriedArgExprs: + | opt_curriedArgExprs argExpr %prec expr_args + { $2 :: $1 } | { [] } diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index d8cfe81430..d17b56c085 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -21,6 +21,7 @@ open FSharp.Compiler.Ast open FSharp.Compiler.CompileOps open FSharp.Compiler.CompileOptions open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Lib open FSharp.Compiler.PrettyNaming open FSharp.Compiler.Parser @@ -716,8 +717,9 @@ type internal TypeCheckInfo | None | Some [] -> let globalItems = allSymbols() - |> List.filter (fun x -> not x.Symbol.IsExplicitlySuppressed) - |> List.filter (fun x -> + |> List.filter (fun x -> + not x.Symbol.IsExplicitlySuppressed && + match x.Symbol with | :? FSharpMemberOrFunctionOrValue as m when m.IsConstructor && filterCtors = ResolveTypeNamesToTypeRefs -> false | _ -> true) @@ -849,7 +851,12 @@ type internal TypeCheckInfo | Some(CompletionContext.OpenDeclaration) -> GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false, getAllSymbols) |> Option.map (fun (items, denv, m) -> - items |> List.filter (fun x -> match x.Item with Item.ModuleOrNamespaces _ -> true | _ -> false), denv, m) + items + |> List.filter (fun x -> + match x.Item with + | Item.ModuleOrNamespaces _ -> true + | Item.Types (_, tcrefs) when tcrefs |> List.exists (fun ty -> isAppTy g ty && isStaticClass g (tcrefOfAppTy g ty)) -> true + | _ -> false), denv, m) // Completion at '(x: ...)" | Some (CompletionContext.PatternType) -> @@ -1276,9 +1283,8 @@ type internal TypeCheckInfo valRefEq g g.reraise_vref vref || valRefEq g g.typeof_vref vref || valRefEq g g.typedefof_vref vref || - valRefEq g g.sizeof_vref vref - // TODO uncomment this after `nameof` operator is implemented - // || valRefEq g g.nameof_vref vref + valRefEq g g.sizeof_vref vref || + valRefEq g g.nameof_vref vref then Some() else None @@ -1525,8 +1531,12 @@ module internal ParseAndCheckFile = let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) tokenizer.Lexer - let createLexbuf sourceText = - UnicodeLexing.SourceTextAsLexbuf(sourceText) + // Public callers are unable to answer LanguageVersion feature support questions. + // External Tools including the VS IDE will enable the default LanguageVersion + let isFeatureSupported (_featureId:LanguageFeature) = true + + let createLexbuf sourceText isFeatureSupported = + UnicodeLexing.SourceTextAsLexbuf(isFeatureSupported, sourceText) let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = let delayedLogger = CapturingErrorLogger("matchBraces") @@ -1541,7 +1551,7 @@ module internal ParseAndCheckFile = use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let matchingBraces = new ResizeArray<_>() - Lexhelp.usingLexbufForParsing(createLexbuf sourceText, fileName) (fun lexbuf -> + Lexhelp.usingLexbufForParsing(createLexbuf sourceText isFeatureSupported, fileName) (fun lexbuf -> let errHandler = ErrorHandler(false, fileName, options.ErrorSeverityOptions, sourceText, suggestNamesForErrors) let lexfun = createLexerFunction fileName options lexbuf errHandler let parenTokensBalance t1 t2 = @@ -1577,7 +1587,7 @@ module internal ParseAndCheckFile = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let parseResult = - Lexhelp.usingLexbufForParsing(createLexbuf sourceText, fileName) (fun lexbuf -> + Lexhelp.usingLexbufForParsing(createLexbuf sourceText isFeatureSupported, fileName) (fun lexbuf -> let lexfun = createLexerFunction fileName options lexbuf errHandler let isLastCompiland = fileName.Equals(options.LastFileName, StringComparison.CurrentCultureIgnoreCase) || diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 4099b59c80..96e81e3214 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1052,7 +1052,7 @@ type TypeCheckAccumulator = /// Global service state -type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list* (*fsharpBinaries*)string +type FrameworkImportsCacheKey = (*resolvedpath*)string list * string * (*TargetFrameworkDirectories*)string list * (*fsharpBinaries*)string * (*langVersion*)decimal /// Represents a cache of 'framework' references that can be shared betweeen multiple incremental builds type FrameworkImportsCache(keepStrongly) = @@ -1083,12 +1083,13 @@ type FrameworkImportsCache(keepStrongly) = // 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, - tcConfig.primaryAssembly.Name, - tcConfig.GetTargetFrameworkDirectories(), - tcConfig.fsharpBinariesDir) + let key = (frameworkDLLsKey, + tcConfig.primaryAssembly.Name, + tcConfig.GetTargetFrameworkDirectories(), + tcConfig.fsharpBinariesDir, + tcConfig.langVersion.SpecifiedVerson) - match frameworkTcImportsCache.TryGet (ctok, key) with + match frameworkTcImportsCache.TryGet (ctok, key) with | Some res -> return res | None -> let tcConfigP = TcConfigProvider.Constant tcConfig diff --git a/src/fsharp/service/Reactor.fs b/src/fsharp/service/Reactor.fs index cc2a6af844..f879e5133f 100755 --- a/src/fsharp/service/Reactor.fs +++ b/src/fsharp/service/Reactor.fs @@ -64,11 +64,7 @@ type Reactor() = Trace.TraceInformation("Reactor: {0:n3} pausing {1} milliseconds", DateTime.Now.TimeOfDay.TotalSeconds, pauseBeforeBackgroundWork) pauseBeforeBackgroundWork return! inbox.TryReceive(timeout) } -#if FX_RESHAPED_GLOBALIZATION - CultureInfo.CurrentUICulture <- culture -#else Thread.CurrentThread.CurrentUICulture <- culture -#endif match msg with | Some (SetBackgroundOp bgOpOpt) -> //Trace.TraceInformation("Reactor: --> set background op, remaining {0}", inbox.CurrentQueueLength) diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index d91cb1f66a..9d07198c0a 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -15,6 +15,7 @@ open FSharp.Compiler.Parser open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.Lib open Internal.Utilities @@ -766,18 +767,22 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, [] type FSharpSourceTokenizer(defineConstants: string list, filename: string option) = + + // Public callers are unable to answer LanguageVersion feature support questions. + // External Tools including the VS IDE will enable the default LanguageVersion + let isFeatureSupported (_featureId:LanguageFeature) = true + let lexResourceManager = new Lexhelp.LexResourceManager() let lexArgsLightOn = mkLexargs(filename, defineConstants, LightSyntaxStatus(true, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty) let lexArgsLightOff = mkLexargs(filename, defineConstants, LightSyntaxStatus(false, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty) member this.CreateLineTokenizer(lineText: string) = - let lexbuf = UnicodeLexing.StringAsLexbuf lineText + let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, lineText) FSharpLineTokenizer(lexbuf, Some lineText.Length, filename, lexArgsLightOn, lexArgsLightOff) - member this.CreateBufferTokenizer bufferFiller = - let lexbuf = UnicodeLexing.FunctionAsLexbuf bufferFiller + let lexbuf = UnicodeLexing.FunctionAsLexbuf(isFeatureSupported, bufferFiller) FSharpLineTokenizer(lexbuf, None, filename, lexArgsLightOn, lexArgsLightOff) module Keywords = diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index abd3472a68..eeab436524 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -412,6 +412,7 @@ module public AstTraversal = dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSeq, synExpr, synExpr2, _, _range) | SynExpr.Sequential (_sequencePointInfoForSeq, _, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index f98fae2f72..84c8947d13 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -299,6 +299,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkTrySeqPt spTry yield! walkFinallySeqPt spFinally + | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _) | SynExpr.Sequential (spSeq, _, e1, e2, _) -> yield! walkExpr (match spSeq with SuppressSequencePointOnStmtOfSequential -> false | _ -> true) e1 yield! walkExpr (match spSeq with SuppressSequencePointOnExprOfSequential -> false | _ -> true) e2 diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 9952631bc5..63e91bfe3c 100755 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -19,6 +19,7 @@ open FSharp.Compiler.CompileOps open FSharp.Compiler.CompileOptions open FSharp.Compiler.Driver open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Features open FSharp.Compiler.Lib open FSharp.Compiler.Range open FSharp.Compiler.TcGlobals diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 1440eef5a4..b1c46d9bd7 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -69,8 +69,8 @@ type FSharpErrorInfo(fileName, s: pos, e: pos, severity: FSharpErrorSeverity, me /// Decompose a warning or error into parts: position, severity, message, error number static member CreateFromExceptionAndAdjustEof(exn, isError, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = let r = FSharpErrorInfo.CreateFromException(exn, isError, fallbackRange, suggestNames) - - // Adjust to make sure that errors reported at Eof are shown at the linesCount + + // Adjust to make sure that errors reported at Eof are shown at the linesCount let startline, schange = min (r.StartLineAlternate, false) (linesCount, true) let endline, echange = min (r.EndLineAlternate, false) (linesCount, true) diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index f6b93d4e32..fcfe2c085f 100755 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -188,8 +188,12 @@ module Impl = type FSharpDisplayContext(denv: TcGlobals -> DisplayEnv) = member x.Contents g = denv g + static member Empty = FSharpDisplayContext(fun g -> DisplayEnv.Empty g) + member x.WithShortTypeNames shortNames = + FSharpDisplayContext(fun g -> { denv g with shortTypeNames = shortNames }) + // delay the realization of 'item' in case it is unresolved type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol -> CcuThunk -> AccessorDomain -> bool)) = diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index c8580fedf3..60c3cecedd 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -50,6 +50,8 @@ type [] public FSharpDisplayContext = internal new : denv: (TcGlobals -> Tastops.DisplayEnv) -> FSharpDisplayContext static member Empty: FSharpDisplayContext + member WithShortTypeNames: bool -> FSharpDisplayContext + /// Represents a symbol in checked F# source code or a compiled .NET component. /// /// The subtype of the symbol may reveal further information and can be one of FSharpEntity, FSharpUnionCase diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index dd8f0506f7..6e063cd831 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -116,133 +116,137 @@ type ValFlags(flags: int64) = new (recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) = let flags = (match baseOrThis with - | BaseVal -> 0b0000000000000000000L - | CtorThisVal -> 0b0000000000000000010L - | NormalVal -> 0b0000000000000000100L - | MemberThisVal -> 0b0000000000000000110L) ||| - (if isCompGen then 0b0000000000000001000L - else 0b00000000000000000000L) ||| + | BaseVal -> 0b00000000000000000000L + | CtorThisVal -> 0b00000000000000000010L + | NormalVal -> 0b00000000000000000100L + | MemberThisVal -> 0b00000000000000000110L) ||| + (if isCompGen then 0b00000000000000001000L + else 0b000000000000000000000L) ||| (match inlineInfo with - | ValInline.PseudoVal -> 0b0000000000000000000L - | ValInline.Always -> 0b0000000000000010000L - | ValInline.Optional -> 0b0000000000000100000L - | ValInline.Never -> 0b0000000000000110000L) ||| + | ValInline.PseudoVal -> 0b00000000000000000000L + | ValInline.Always -> 0b00000000000000010000L + | ValInline.Optional -> 0b00000000000000100000L + | ValInline.Never -> 0b00000000000000110000L) ||| (match isMutable with - | Immutable -> 0b0000000000000000000L - | Mutable -> 0b0000000000001000000L) ||| + | Immutable -> 0b00000000000000000000L + | Mutable -> 0b00000000000001000000L) ||| (match isModuleOrMemberBinding with - | false -> 0b0000000000000000000L - | true -> 0b0000000000010000000L) ||| + | false -> 0b00000000000000000000L + | true -> 0b00000000000010000000L) ||| (match isExtensionMember with - | false -> 0b0000000000000000000L - | true -> 0b0000000000100000000L) ||| + | false -> 0b00000000000000000000L + | true -> 0b00000000000100000000L) ||| (match isIncrClassSpecialMember with - | false -> 0b0000000000000000000L - | true -> 0b0000000001000000000L) ||| + | false -> 0b00000000000000000000L + | true -> 0b00000000001000000000L) ||| (match isTyFunc with - | false -> 0b0000000000000000000L - | true -> 0b0000000010000000000L) ||| + | false -> 0b00000000000000000000L + | true -> 0b00000000010000000000L) ||| (match recValInfo with - | ValNotInRecScope -> 0b0000000000000000000L - | ValInRecScope true -> 0b0000000100000000000L - | ValInRecScope false -> 0b0000001000000000000L) ||| + | ValNotInRecScope -> 0b00000000000000000000L + | ValInRecScope true -> 0b00000000100000000000L + | ValInRecScope false -> 0b00000001000000000000L) ||| (match allowTypeInst with - | false -> 0b0000000000000000000L - | true -> 0b0000100000000000000L) ||| + | false -> 0b00000000000000000000L + | true -> 0b00000100000000000000L) ||| (match isGeneratedEventVal with - | false -> 0b0000000000000000000L - | true -> 0b0100000000000000000L) + | false -> 0b00000000000000000000L + | true -> 0b00100000000000000000L) ValFlags flags member x.BaseOrThisInfo = - match (flags &&& 0b0000000000000000110L) with - | 0b0000000000000000000L -> BaseVal - | 0b0000000000000000010L -> CtorThisVal - | 0b0000000000000000100L -> NormalVal - | 0b0000000000000000110L -> MemberThisVal + match (flags &&& 0b00000000000000000110L) with + | 0b00000000000000000000L -> BaseVal + | 0b00000000000000000010L -> CtorThisVal + | 0b00000000000000000100L -> NormalVal + | 0b00000000000000000110L -> MemberThisVal | _ -> failwith "unreachable" - member x.IsCompilerGenerated = (flags &&& 0b0000000000000001000L) <> 0x0L + member x.IsCompilerGenerated = (flags &&& 0b00000000000000001000L) <> 0x0L member x.SetIsCompilerGenerated isCompGen = - let flags = (flags &&& ~~~0b0000000000000001000L) ||| + let flags = (flags &&& ~~~0b00000000000000001000L) ||| (match isCompGen with - | false -> 0b0000000000000000000L - | true -> 0b0000000000000001000L) + | false -> 0b00000000000000000000L + | true -> 0b00000000000000001000L) ValFlags flags member x.InlineInfo = - match (flags &&& 0b0000000000000110000L) with - | 0b0000000000000000000L -> ValInline.PseudoVal - | 0b0000000000000010000L -> ValInline.Always - | 0b0000000000000100000L -> ValInline.Optional - | 0b0000000000000110000L -> ValInline.Never + match (flags &&& 0b00000000000000110000L) with + | 0b00000000000000000000L -> ValInline.PseudoVal + | 0b00000000000000010000L -> ValInline.Always + | 0b00000000000000100000L -> ValInline.Optional + | 0b00000000000000110000L -> ValInline.Never | _ -> failwith "unreachable" member x.MutabilityInfo = - match (flags &&& 0b0000000000001000000L) with - | 0b0000000000000000000L -> Immutable - | 0b0000000000001000000L -> Mutable + match (flags &&& 0b00000000000001000000L) with + | 0b00000000000000000000L -> Immutable + | 0b00000000000001000000L -> Mutable | _ -> failwith "unreachable" member x.IsMemberOrModuleBinding = - match (flags &&& 0b0000000000010000000L) with - | 0b0000000000000000000L -> false - | 0b0000000000010000000L -> true + match (flags &&& 0b00000000000010000000L) with + | 0b00000000000000000000L -> false + | 0b00000000000010000000L -> true | _ -> failwith "unreachable" - member x.WithIsMemberOrModuleBinding = ValFlags(flags ||| 0b0000000000010000000L) + member x.WithIsMemberOrModuleBinding = ValFlags(flags ||| 0b00000000000010000000L) - member x.IsExtensionMember = (flags &&& 0b0000000000100000000L) <> 0L + member x.IsExtensionMember = (flags &&& 0b00000000000100000000L) <> 0L - member x.IsIncrClassSpecialMember = (flags &&& 0b0000000001000000000L) <> 0L + member x.IsIncrClassSpecialMember = (flags &&& 0b00000000001000000000L) <> 0L - member x.IsTypeFunction = (flags &&& 0b0000000010000000000L) <> 0L + member x.IsTypeFunction = (flags &&& 0b00000000010000000000L) <> 0L - member x.RecursiveValInfo = match (flags &&& 0b0000001100000000000L) with - | 0b0000000000000000000L -> ValNotInRecScope - | 0b0000000100000000000L -> ValInRecScope true - | 0b0000001000000000000L -> ValInRecScope false + member x.RecursiveValInfo = match (flags &&& 0b00000001100000000000L) with + | 0b00000000000000000000L -> ValNotInRecScope + | 0b00000000100000000000L -> ValInRecScope true + | 0b00000001000000000000L -> ValInRecScope false | _ -> failwith "unreachable" member x.WithRecursiveValInfo recValInfo = let flags = - (flags &&& ~~~0b0000001100000000000L) ||| + (flags &&& ~~~0b00000001100000000000L) ||| (match recValInfo with - | ValNotInRecScope -> 0b0000000000000000000L - | ValInRecScope true -> 0b0000000100000000000L - | ValInRecScope false -> 0b0000001000000000000L) + | ValNotInRecScope -> 0b00000000000000000000L + | ValInRecScope true -> 0b00000000100000000000L + | ValInRecScope false -> 0b00000001000000000000L) ValFlags flags - member x.MakesNoCriticalTailcalls = (flags &&& 0b0000010000000000000L) <> 0L + member x.MakesNoCriticalTailcalls = (flags &&& 0b00000010000000000000L) <> 0L - member x.WithMakesNoCriticalTailcalls = ValFlags(flags ||| 0b0000010000000000000L) + member x.WithMakesNoCriticalTailcalls = ValFlags(flags ||| 0b00000010000000000000L) - member x.PermitsExplicitTypeInstantiation = (flags &&& 0b0000100000000000000L) <> 0L + member x.PermitsExplicitTypeInstantiation = (flags &&& 0b00000100000000000000L) <> 0L - member x.HasBeenReferenced = (flags &&& 0b0001000000000000000L) <> 0L + member x.HasBeenReferenced = (flags &&& 0b00001000000000000000L) <> 0L - member x.WithHasBeenReferenced = ValFlags(flags ||| 0b0001000000000000000L) + member x.WithHasBeenReferenced = ValFlags(flags ||| 0b00001000000000000000L) - member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b0010000000000000000L) <> 0L + member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b00010000000000000000L) <> 0L - member x.WithIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b0010000000000000000L) + member x.WithIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b00010000000000000000L) - member x.IsGeneratedEventVal = (flags &&& 0b0100000000000000000L) <> 0L + member x.IsGeneratedEventVal = (flags &&& 0b00100000000000000000L) <> 0L - member x.IsFixed = (flags &&& 0b1000000000000000000L) <> 0L + member x.IsFixed = (flags &&& 0b01000000000000000000L) <> 0L - member x.WithIsFixed = ValFlags(flags ||| 0b1000000000000000000L) + member x.WithIsFixed = ValFlags(flags ||| 0b01000000000000000000L) + + member x.IgnoresByrefScope = (flags &&& 0b10000000000000000000L) <> 0L + + member x.WithIgnoresByrefScope = ValFlags(flags ||| 0b10000000000000000000L) /// Get the flags as included in the F# binary metadata member x.PickledBits = @@ -250,7 +254,7 @@ type ValFlags(flags: int64) = // Clear the IsCompiledAsStaticPropertyWithoutField, only used to determine whether to use a true field for a value, and to eliminate the optimization info for observable bindings // Clear the HasBeenReferenced, only used to report "unreferenced variable" warnings and to help collect 'it' values in FSI.EXE // Clear the IsGeneratedEventVal, since there's no use in propagating specialname information for generated add/remove event vals - (flags &&& ~~~0b0011001100000000000L) + (flags &&& ~~~0b10011001100000000000L) /// Represents the kind of a type parameter [] @@ -423,9 +427,9 @@ type EntityFlags(flags: int64) = /// These two bits represents the on-demand analysis about whether the entity has the IsByRefLike attribute member x.TryIsByRefLike = (flags &&& 0b000000011000000L) |> function - | 0b000000011000000L -> Some true - | 0b000000010000000L -> Some false - | _ -> None + | 0b000000011000000L -> ValueSome true + | 0b000000010000000L -> ValueSome false + | _ -> ValueNone /// Adjust the on-demand analysis about whether the entity has the IsByRefLike attribute member x.WithIsByRefLike flag = @@ -436,14 +440,14 @@ type EntityFlags(flags: int64) = | false -> 0b000000010000000L) EntityFlags flags - /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct + /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute member x.TryIsReadOnly = (flags &&& 0b000001100000000L) |> function - | 0b000001100000000L -> Some true - | 0b000001000000000L -> Some false - | _ -> None + | 0b000001100000000L -> ValueSome true + | 0b000001000000000L -> ValueSome false + | _ -> ValueNone - /// Adjust the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct + /// Adjust the on-demand analysis about whether the entity has the IsReadOnly attribute member x.WithIsReadOnly flag = let flags = (flags &&& ~~~0b000001100000000L) ||| @@ -452,8 +456,24 @@ type EntityFlags(flags: int64) = | false -> 0b000001000000000L) EntityFlags flags + /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct + member x.TryIsAssumedReadOnly = (flags &&& 0b000110000000000L) + |> function + | 0b000110000000000L -> ValueSome true + | 0b000100000000000L -> ValueSome false + | _ -> ValueNone + + /// Adjust the on-demand analysis about whether the entity is assumed to be a readonly struct + member x.WithIsAssumedReadOnly flag = + let flags = + (flags &&& ~~~0b000110000000000L) ||| + (match flag with + | true -> 0b000110000000000L + | false -> 0b000100000000000L) + EntityFlags flags + /// Get the flags as included in the F# binary metadata - member x.PickledBits = (flags &&& ~~~0b000001111000100L) + member x.PickledBits = (flags &&& ~~~0b000111111000100L) #if DEBUG @@ -1065,12 +1085,18 @@ and /// Represents a type definition, exception definition, module definition or /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute member x.SetIsByRefLike b = x.entity_flags <- x.entity_flags.WithIsByRefLike b - /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct + /// These two bits represents the on-demand analysis about whether the entity has the IsReadOnly attribute member x.TryIsReadOnly = x.entity_flags.TryIsReadOnly - /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct + /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute member x.SetIsReadOnly b = x.entity_flags <- x.entity_flags.WithIsReadOnly b + /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct + member x.TryIsAssumedReadOnly = x.entity_flags.TryIsAssumedReadOnly + + /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct + member x.SetIsAssumedReadOnly b = x.entity_flags <- x.entity_flags.WithIsAssumedReadOnly b + /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpObjectRepr _ -> true | _ -> false @@ -1446,7 +1472,10 @@ and IsSealed: bool /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsInterface: bool + IsAbstract: bool + + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsInterface: bool /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. IsStructOrEnum: bool @@ -2009,6 +2038,7 @@ and Construct = IsStructOrEnum = st.PUntaint((fun st -> st.IsValueType || st.IsEnum), m) IsInterface = st.PUntaint((fun st -> st.IsInterface), m) IsSealed = st.PUntaint((fun st -> st.IsSealed), m) + IsAbstract = st.PUntaint((fun st -> st.IsAbstract), m) IsClass = st.PUntaint((fun st -> st.IsClass), m) IsErased = isErased IsSuppressRelocate = isSuppressRelocate } @@ -2721,6 +2751,9 @@ and [] /// Indicates if the value is pinned/fixed member x.IsFixed = x.val_flags.IsFixed + /// Indicates if the value will ignore byref scoping rules + member x.IgnoresByrefScope = x.val_flags.IgnoresByrefScope + /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments, /// or does it have a signature?) member x.PermitsExplicitTypeInstantiation = x.val_flags.PermitsExplicitTypeInstantiation @@ -2944,6 +2977,8 @@ and [] member x.SetIsFixed() = x.val_flags <- x.val_flags.WithIsFixed + member x.SetIgnoresByrefScope() = x.val_flags <- x.val_flags.WithIgnoresByrefScope + member x.SetValReprInfo info = match x.val_opt_data with | Some optData -> optData.val_repr_info <- info @@ -3547,12 +3582,18 @@ and /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute member x.SetIsByRefLike b = x.Deref.SetIsByRefLike b - /// The on-demand analysis about whether the entity has the IsByRefLike attribute + /// The on-demand analysis about whether the entity has the IsReadOnly attribute member x.TryIsReadOnly = x.Deref.TryIsReadOnly - /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute or is otherwise determined to be a readonly struct + /// Set the on-demand analysis about whether the entity has the IsReadOnly attribute member x.SetIsReadOnly b = x.Deref.SetIsReadOnly b + /// The on-demand analysis about whether the entity is assumed to be a readonly struct + member x.TryIsAssumedReadOnly = x.Deref.TryIsAssumedReadOnly + + /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct + member x.SetIsAssumedReadOnly b = x.Deref.SetIsAssumedReadOnly b + /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, /// which in F# is called a 'unknown representation' type). member x.IsHiddenReprTycon = x.Deref.IsHiddenReprTycon diff --git a/src/utils/CompilerLocationUtils.fs b/src/utils/CompilerLocationUtils.fs index df0c7123b4..95aa5c5a31 100755 --- a/src/utils/CompilerLocationUtils.fs +++ b/src/utils/CompilerLocationUtils.fs @@ -23,20 +23,7 @@ module internal FSharpEnvironment = #endif let versionOf<'t> = -#if FX_RESHAPED_REFLECTION - let aq = (typeof<'t>).AssemblyQualifiedName - let version = - if aq <> null then - let x = aq.Split(',', ' ') |> Seq.filter(fun x -> x.StartsWith("Version=", StringComparison.OrdinalIgnoreCase)) |> Seq.tryHead - match x with - | Some(x) -> x.Substring(8) - | _ -> null - else - null - version -#else typeof<'t>.Assembly.GetName().Version.ToString() -#endif let FSharpCoreLibRunningVersion = try match versionOf with @@ -200,7 +187,7 @@ module internal FSharpEnvironment = #else // Check for an app.config setting to redirect the default compiler location // Like fsharp-compiler-location - try + try // FSharp.Compiler support setting an appkey for compiler location. I've never seen this used. let result = tryAppConfig "fsharp-compiler-location" match result with diff --git a/src/utils/prim-lexing.fs b/src/utils/prim-lexing.fs index c397257b46..1f772d6e87 100755 --- a/src/utils/prim-lexing.fs +++ b/src/utils/prim-lexing.fs @@ -50,12 +50,12 @@ type StringText(str: string) = lazy getLines str member __.String = str - + override __.GetHashCode() = str.GetHashCode() override __.Equals(obj: obj) = str.Equals(obj) interface ISourceText with - + member __.Item with get index = str.[index] member __.GetLastCharacterPosition() = @@ -106,6 +106,7 @@ namespace Internal.Utilities.Text.Lexing open FSharp.Compiler.Text open Microsoft.FSharp.Core open Microsoft.FSharp.Collections + open FSharp.Compiler.Features open System.Collections.Generic [] @@ -168,11 +169,11 @@ namespace Internal.Utilities.Text.Lexing 0, 0) - type internal LexBufferFiller<'Char> = (LexBuffer<'Char> -> unit) - + type internal LexBufferFiller<'Char> = (LexBuffer<'Char> -> unit) + and [] - internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>) = - let context = new Dictionary(1) + internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, supportsFeature:LanguageFeature -> bool) = + let context = new Dictionary(1) let mutable buffer = [||] /// number of valid characters beyond bufferScanStart. let mutable bufferMaxScanLength = 0 @@ -195,8 +196,7 @@ namespace Internal.Utilities.Text.Lexing Array.blit keep 0 buffer 0 nkeep bufferScanStart <- 0 bufferMaxScanLength <- nkeep - - + member lexbuf.EndOfScan () : int = //Printf.eprintf "endOfScan, lexBuffer.lexemeLength = %d\n" lexBuffer.lexemeLength; if bufferAcceptAction < 0 then @@ -211,13 +211,12 @@ namespace Internal.Utilities.Text.Lexing member lexbuf.StartPos with get() = startPos and set b = startPos <- b - + member lexbuf.EndPos with get() = endPos and set b = endPos <- b member lexbuf.Lexeme = Array.sub buffer bufferScanStart lexemeLength - member lexbuf.BufferLocalStore = (context :> IDictionary<_,_>) member lexbuf.LexemeLength with get() : int = lexemeLength and set v = lexemeLength <- v member lexbuf.Buffer with get() : 'Char[] = buffer and set v = buffer <- v @@ -238,45 +237,46 @@ namespace Internal.Utilities.Text.Lexing member x.BufferScanPos = bufferScanStart + bufferScanLength member lexbuf.EnsureBufferSize n = - if lexbuf.BufferScanPos + n >= buffer.Length then - let repl = Array.zeroCreate (lexbuf.BufferScanPos + n) + if lexbuf.BufferScanPos + n >= buffer.Length then + let repl = Array.zeroCreate (lexbuf.BufferScanPos + n) Array.blit buffer bufferScanStart repl bufferScanStart bufferScanLength buffer <- repl + member __.SupportsFeature featureId = supportsFeature featureId - static member FromFunction (f : 'Char[] * int * int -> int) : LexBuffer<'Char> = + static member FromFunction (supportsFeature:LanguageFeature -> bool, f : 'Char[] * int * int -> int) : LexBuffer<'Char> = let extension= Array.zeroCreate 4096 let filler (lexBuffer: LexBuffer<'Char>) = let n = f (extension,0,extension.Length) lexBuffer.EnsureBufferSize n Array.blit extension 0 lexBuffer.Buffer lexBuffer.BufferScanPos n lexBuffer.BufferMaxScanLength <- lexBuffer.BufferScanLength + n - new LexBuffer<'Char>(filler) - + new LexBuffer<'Char>(filler, supportsFeature) + // Important: This method takes ownership of the array - static member FromArrayNoCopy (buffer: 'Char[]) : LexBuffer<'Char> = - let lexBuffer = new LexBuffer<'Char>(fun _ -> ()) + static member FromArrayNoCopy (supportsFeature:LanguageFeature -> bool, buffer: 'Char[]) : LexBuffer<'Char> = + let lexBuffer = new LexBuffer<'Char>((fun _ -> ()), supportsFeature) lexBuffer.Buffer <- buffer lexBuffer.BufferMaxScanLength <- buffer.Length lexBuffer // Important: this method does copy the array - static member FromArray (s: 'Char[]) : LexBuffer<'Char> = + static member FromArray (supportsFeature: LanguageFeature -> bool, s: 'Char[]) : LexBuffer<'Char> = let buffer = Array.copy s - LexBuffer<'Char>.FromArrayNoCopy buffer + LexBuffer<'Char>.FromArrayNoCopy(supportsFeature, buffer) // Important: This method takes ownership of the array - static member FromChars (arr:char[]) = LexBuffer.FromArrayNoCopy arr - - static member FromSourceText (sourceText: ISourceText) = + static member FromChars (supportsFeature:LanguageFeature -> bool, arr:char[]) = LexBuffer.FromArrayNoCopy (supportsFeature, arr) + + static member FromSourceText (supportsFeature: LanguageFeature -> bool, sourceText: ISourceText) = let mutable currentSourceIndex = 0 - LexBuffer.FromFunction(fun (chars, start, length) -> + LexBuffer.FromFunction(supportsFeature, fun (chars, start, length) -> let lengthToCopy = if currentSourceIndex + length <= sourceText.Length then length else sourceText.Length - currentSourceIndex - + if lengthToCopy <= 0 then 0 else sourceText.CopyTo(currentSourceIndex, chars, start, lengthToCopy) @@ -312,7 +312,6 @@ namespace Internal.Utilities.Text.Lexing open GenericImplFragments - [] type internal UnicodeTables(trans: uint16[] array, accept: uint16[]) = let sentinel = 255 * 256 + 255 @@ -334,11 +333,7 @@ namespace Internal.Utilities.Text.Lexing // ways let baseForUnicodeCategories = numLowUnicodeChars+numSpecificUnicodeChars*2 let unicodeCategory = -#if FX_RESHAPED_GLOBALIZATION - System.Globalization.CharUnicodeInfo.GetUnicodeCategory(inp) -#else System.Char.GetUnicodeCategory(inp) -#endif //System.Console.WriteLine("inp = {0}, unicodeCategory = {1}", [| box inp; box unicodeCategory |]); int trans.[state].[baseForUnicodeCategories + int32 unicodeCategory] else @@ -349,10 +344,9 @@ namespace Internal.Utilities.Text.Lexing if c = inp then int trans.[state].[baseForSpecificUnicodeChars+i*2+1] else loop(i+1) - loop 0 let eofPos = numLowUnicodeChars + 2*numSpecificUnicodeChars + numUnicodeCategories - + let rec scanUntilSentinel lexBuffer state = // Return an endOfScan after consuming the input let a = int accept.[state] diff --git a/src/utils/prim-lexing.fsi b/src/utils/prim-lexing.fsi index 4b4fd58717..bf9eb3171c 100755 --- a/src/utils/prim-lexing.fsi +++ b/src/utils/prim-lexing.fsi @@ -39,6 +39,7 @@ open System.Collections.Generic open FSharp.Compiler.Text open Microsoft.FSharp.Core open Microsoft.FSharp.Control +open FSharp.Compiler.Features /// Position information stored for lexing tokens [] @@ -78,12 +79,12 @@ type internal Position = /// Apply a #line directive. member ApplyLineDirective : fileIdx:int * line:int -> Position - + /// Get an arbitrary position, with the empty string as filename. static member Empty : Position - + static member FirstLine : fileIdx:int -> Position - + [] /// Input buffers consumed by lexers generated by fslex.exe. /// The type must be generic to match the code generated by FsLex and FsYacc (if you would like to @@ -97,24 +98,28 @@ type internal LexBuffer<'Char> = /// The matched string. member Lexeme: 'Char [] - + /// Fast helper to turn the matched characters into a string, avoiding an intermediate array. static member LexemeString : LexBuffer -> string - + /// Dynamically typed, non-lexically scoped parameter table. member BufferLocalStore : IDictionary - + /// True if the refill of the buffer ever failed , or if explicitly set to True. member IsPastEndOfStream: bool with get,set + /// True if the refill of the buffer ever failed , or if explicitly set to True. + member SupportsFeature:LanguageFeature -> bool + /// Create a lex buffer suitable for Unicode lexing that reads characters from the given array. /// Important: does take ownership of the array. - static member FromChars: char[] -> LexBuffer + static member FromChars: (LanguageFeature -> bool) * char[] -> LexBuffer /// Create a lex buffer that reads character or byte inputs by using the given function. - static member FromFunction: ('Char[] * int * int -> int) -> LexBuffer<'Char> + static member FromFunction: (LanguageFeature -> bool) * ('Char[] * int * int -> int) -> LexBuffer<'Char> + /// Create a lex buffer backed by source text. - static member FromSourceText : ISourceText -> LexBuffer + static member FromSourceText : (LanguageFeature -> bool) * ISourceText -> LexBuffer /// The type of tables for an unicode lexer generated by fslex.exe. [] diff --git a/src/utils/reshapedmsbuild.fs b/src/utils/reshapedmsbuild.fs index 75859f4476..20b5cd6f96 100644 --- a/src/utils/reshapedmsbuild.fs +++ b/src/utils/reshapedmsbuild.fs @@ -21,41 +21,45 @@ type ITaskItem = abstract member CopyMetadataTo : ITaskItem -> unit abstract member CloneCustomMetadata : IDictionary -namespace Microsoft.Build.Utilities -open Microsoft.Build.Framework -open Microsoft.FSharp.Core.ReflectionAdapters -open System -open System.Collections -open System.Reflection - -type TaskItem (itemSpec:string) = - let assembly = Assembly.Load(new AssemblyName("Microsoft.Build.Utilities.Core, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")) - let buildUtilitiesTaskType = assembly.GetType("Microsoft.Build.Utilities.Task") - let instance = Activator.CreateInstance(buildUtilitiesTaskType, [|itemSpec|]) - - interface ITaskItem with - member this.ItemSpec - with get () :string = (instance.GetPropertyValue("ItemSpec") :?> string) - and set (value:string) = (instance.SetPropertyValue("ItemSpec", value)); () - member this.MetadataNames - with get () :ICollection = (instance.GetPropertyValue("MetadataNames") :?> ICollection) - member this.MetadataCount - with get () :int = (instance.GetPropertyValue("MetadataCount") :?> int) - member this.CopyMetadataTo(iTaskItem) = - let m = buildUtilitiesTaskType.GetMethod("CopyMetadataTo", [| typeof |]) - m.Invoke(instance, [|iTaskItem :>obj|]) |> ignore - member this.CloneCustomMetadata = - let m = buildUtilitiesTaskType.GetMethod("CloneCustomMetadata", [||]) - (m.Invoke(instance,[||])) :?>IDictionary - member this.GetMetadata(metadataName) = - let m = buildUtilitiesTaskType.GetMethod("GetMetadata", [|typeof|]) - (m.Invoke(instance,[|metadataName|])) :?>string - member this.RemoveMetadata(metadataName) = - let m = buildUtilitiesTaskType.GetMethod("RemoveMetadata", [|typeof|]) - (m.Invoke(instance,[|metadataName|])) :?>string |>ignore - member this.SetMetadata(metadataName, metadataValue) = - let m = buildUtilitiesTaskType.GetMethod("SetMetadata", [|typeof;typeof|]) - (m.Invoke(instance,[|metadataName; metadataValue|])) |>ignore +module Utilities = + open Microsoft.Build.Framework + open System + open System.Collections + open System.Reflection + + type System.Object with + member this.GetPropertyValue(propName) = this.GetType().GetProperty(propName, BindingFlags.Public).GetValue(this, null) + member this.SetPropertyValue(propName, propValue) = this.GetType().GetProperty(propName, BindingFlags.Public).SetValue(this, propValue, null) + member this.GetMethod(methodName, argTypes) = this.GetType().GetMethod(methodName, argTypes, [||]) + + type TaskItem (itemSpec:string) = + let assembly = Assembly.Load(new AssemblyName("Microsoft.Build.Utilities.Core, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")) + let buildUtilitiesTaskType = assembly.GetType("Microsoft.Build.Utilities.Task") + let instance = Activator.CreateInstance(buildUtilitiesTaskType, [|itemSpec|]) + + interface ITaskItem with + member this.ItemSpec + with get () :string = (instance.GetPropertyValue("ItemSpec") :?> string) + and set (value:string) = (instance.SetPropertyValue("ItemSpec", value)); () + member this.MetadataNames + with get () :ICollection = (instance.GetPropertyValue("MetadataNames") :?> ICollection) + member this.MetadataCount + with get () :int = (instance.GetPropertyValue("MetadataCount") :?> int) + member this.CopyMetadataTo(iTaskItem) = + let m = buildUtilitiesTaskType.GetMethod("CopyMetadataTo", [| typeof |]) + m.Invoke(instance, [|iTaskItem :>obj|]) |> ignore + member this.CloneCustomMetadata = + let m = buildUtilitiesTaskType.GetMethod("CloneCustomMetadata", [||]) + (m.Invoke(instance,[||])) :?>IDictionary + member this.GetMetadata(metadataName) = + let m = buildUtilitiesTaskType.GetMethod("GetMetadata", [|typeof|]) + (m.Invoke(instance,[|metadataName|])) :?>string + member this.RemoveMetadata(metadataName) = + let m = buildUtilitiesTaskType.GetMethod("RemoveMetadata", [|typeof|]) + (m.Invoke(instance,[|metadataName|])) :?>string |>ignore + member this.SetMetadata(metadataName, metadataValue) = + let m = buildUtilitiesTaskType.GetMethod("SetMetadata", [|typeof;typeof|]) + (m.Invoke(instance,[|metadataName; metadataValue|])) |>ignore namespace FSharp.Compiler open System @@ -66,11 +70,10 @@ open System.Linq open System.Runtime.Versioning open FSComp open Microsoft.Win32 +open Microsoft.Build.Framework.Utilities module internal MsBuildAdapters = - open Microsoft.FSharp.Core.ReflectionAdapters - /// /// Used to specify the targeted version of the .NET Framework for some methods of ToolLocationHelper. This is meant to mimic /// the official version here: https://source.dot.net/#q=TargetDotNetFrameworkVersion. @@ -102,7 +105,6 @@ module internal MsBuildAdapters = module internal ToolLocationHelper = open Microsoft.Build.Framework - open Microsoft.FSharp.Core.ReflectionAdapters open System.Linq open System.Reflection open MsBuildAdapters diff --git a/src/utils/reshapedreflection.fs b/src/utils/reshapedreflection.fs deleted file mode 100644 index 0b143951dd..0000000000 --- a/src/utils/reshapedreflection.fs +++ /dev/null @@ -1,401 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.FSharp.Core -open System.Reflection - -//Replacement for: System.Security.SecurityElement.Escape(line) All platforms -module internal XmlAdapters = - open System.Text - open Microsoft.FSharp.Collections - - let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |] - - let getEscapeSequence c = - match c with - | '<' -> "<" - | '>' -> ">" - | '\"' -> """ - | '\'' -> "'" - | '&' -> "&" - | _ as ch -> ch.ToString() - - let escape str = String.collect getEscapeSequence str - -#if FX_RESHAPED_REFLECTION -module internal ReflectionAdapters = - open System - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Collections - open PrimReflectionAdapters - - let inline hasFlag (flag : BindingFlags) f = (f &&& flag) = flag - let isDeclaredFlag f = hasFlag BindingFlags.DeclaredOnly f - let isPublicFlag f = hasFlag BindingFlags.Public f - let isStaticFlag f = hasFlag BindingFlags.Static f - let isInstanceFlag f = hasFlag BindingFlags.Instance f - let isNonPublicFlag f = hasFlag BindingFlags.NonPublic f - - let isAcceptable bindingFlags isStatic isPublic = - // 1. check if member kind (static\instance) was specified in flags - ((isStaticFlag bindingFlags && isStatic) || (isInstanceFlag bindingFlags && not isStatic)) && - // 2. check if member accessibility was specified in flags - ((isPublicFlag bindingFlags && isPublic) || (isNonPublicFlag bindingFlags && not isPublic)) - - let publicFlags = BindingFlags.Public ||| BindingFlags.Instance ||| BindingFlags.Static - - let commit (results : _[]) = - match results with - | [||] -> null - | [| m |] -> m - | _ -> raise (AmbiguousMatchException()) - - let canUseAccessor (accessor : MethodInfo) nonPublic = - (not (isNull (box accessor))) && (accessor.IsPublic || nonPublic) - - type System.Type with - member this.GetTypeInfo() = IntrospectionExtensions.GetTypeInfo(this) - member this.GetRuntimeProperties() = RuntimeReflectionExtensions.GetRuntimeProperties(this) - member this.GetRuntimeEvents() = RuntimeReflectionExtensions.GetRuntimeEvents(this) - member this.Attributes = this.GetTypeInfo().Attributes - member this.GetCustomAttributes(attrTy, inherits) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this.GetTypeInfo(), attrTy, inherits) |> Seq.toArray) - member this.GetNestedType (name, bindingFlags) = - // MSDN: http://msdn.microsoft.com/en-us/library/0dcb3ad5.aspx - // The following BindingFlags filter flags can be used to define which nested types to include in the search: - // You must specify either BindingFlags.Public or BindingFlags.NonPublic to get a return. - // Specify BindingFlags.Public to include public nested types in the search. - // Specify BindingFlags.NonPublic to include non-public nested types (that is, private, internal, and protected nested types) in the search. - // This method returns only the nested types of the current type. It does not search the base classes of the current type. - // To find types that are nested in base classes, you must walk the inheritance hierarchy, calling GetNestedType at each level. - let nestedTyOpt = - this.GetTypeInfo().DeclaredNestedTypes - |> Seq.tryFind (fun nestedTy -> - nestedTy.Name = name && ( - (isPublicFlag bindingFlags && nestedTy.IsNestedPublic) || - (isNonPublicFlag bindingFlags && (nestedTy.IsNestedPrivate || nestedTy.IsNestedFamily || nestedTy.IsNestedAssembly || nestedTy.IsNestedFamORAssem || nestedTy.IsNestedFamANDAssem)) - ) - ) - |> Option.map (fun ti -> ti.AsType()) - defaultArg nestedTyOpt null - // use different sources based on Declared flag - member this.GetMethods(bindingFlags) = - (if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredMethods else this.GetRuntimeMethods()) - |> Seq.filter (fun m -> isAcceptable bindingFlags m.IsStatic m.IsPublic) - |> Seq.toArray - - // use different sources based on Declared flag - member this.GetFields(bindingFlags) = - (if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredFields else this.GetRuntimeFields()) - |> Seq.filter (fun f -> isAcceptable bindingFlags f.IsStatic f.IsPublic) - |> Seq.toArray - - // use different sources based on Declared flag - member this.GetProperties(?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - (if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredProperties else this.GetRuntimeProperties()) - |> Seq.filter (fun pi-> - let mi = match pi.GetMethod with | null -> pi.SetMethod | _ -> pi.GetMethod - if mi = null then false - else isAcceptable bindingFlags mi.IsStatic mi.IsPublic - ) - |> Seq.toArray - - member this.GetEvents(?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - (if isDeclaredFlag bindingFlags then this.GetTypeInfo().DeclaredEvents else this.GetRuntimeEvents()) - |> Seq.filter (fun ei-> - let m = ei.GetAddMethod(true) - if m = null then false - else isAcceptable bindingFlags m.IsStatic m.IsPublic - ) - |> Seq.toArray - - member this.GetEvent(name, ?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - this.GetEvents(bindingFlags) - |> Array.filter (fun ei -> ei.Name = name) - |> commit - - member this.GetConstructor(bindingFlags, _binder, argsT:Type[], _parameterModifiers) = - this.GetConstructor(bindingFlags,argsT) - - member this.GetMethod(name, ?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - this.GetMethods(bindingFlags) - |> Array.filter(fun m -> m.Name = name) - |> commit - - member this.GetMethod(name, _bindingFlags, _binder, argsT:Type[], _parameterModifiers) = - this.GetMethod(name, argsT) - - // use different sources based on Declared flag - member this.GetProperty(name, bindingFlags) = - this.GetProperties(bindingFlags) - |> Array.filter (fun pi -> pi.Name = name) - |> commit - - member this.GetMethod(methodName, args:Type[], ?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - let compareSequences parms args = - Seq.compareWith (fun parm arg -> if parm <> arg then 1 else 0) parms args - this.GetMethods(bindingFlags) - |> Array.filter(fun m -> m.Name = methodName && (compareSequences (m.GetParameters() |> Seq.map(fun x -> x.ParameterType)) args) = 0) - |> commit - - member this.GetNestedTypes(?bindingFlags) = - let bindingFlags = defaultArg bindingFlags publicFlags - this.GetTypeInfo().DeclaredNestedTypes - |> Seq.filter (fun nestedTy-> - (isPublicFlag bindingFlags && nestedTy.IsNestedPublic) || - (isNonPublicFlag bindingFlags && (nestedTy.IsNestedPrivate || nestedTy.IsNestedFamily || nestedTy.IsNestedAssembly || nestedTy.IsNestedFamORAssem || nestedTy.IsNestedFamANDAssem))) - |> Seq.map (fun ti -> ti.AsType()) - |> Seq.toArray - - member this.GetEnumUnderlyingType() = - Enum.GetUnderlyingType(this) - - member this.InvokeMember(memberName, bindingFlags, _binder, target:obj, arguments:obj[], _cultureInfo) = - let m = this.GetMethod(memberName, (arguments |> Seq.map(fun x -> x.GetType()) |> Seq.toArray), bindingFlags) - match m with - | null -> raise <| System.MissingMethodException(String.Format("Method '{0}.{1}' not found.", this.FullName, memberName)) - | _ -> m.Invoke(target, arguments) - - member this.IsGenericType = this.GetTypeInfo().IsGenericType - - member this.IsGenericTypeDefinition = this.GetTypeInfo().IsGenericTypeDefinition - - member this.GetGenericArguments() = - if this.IsGenericTypeDefinition then this.GetTypeInfo().GenericTypeParameters - elif this.IsGenericType then this.GenericTypeArguments - else [||] - - member this.IsInterface = this.GetTypeInfo().IsInterface - - member this.IsPublic = this.GetTypeInfo().IsPublic - - member this.IsNestedPublic = this.GetTypeInfo().IsNestedPublic - - member this.IsClass = this.GetTypeInfo().IsClass - - member this.IsValueType = this.GetTypeInfo().IsValueType - - member this.IsSealed = this.GetTypeInfo().IsSealed - - member this.BaseType = this.GetTypeInfo().BaseType - - member this.GetConstructor(bindingFlags, parameterTypes : Type[]) = - this.GetTypeInfo().DeclaredConstructors - |> Seq.filter (fun ci -> isAcceptable bindingFlags ci.IsStatic ci.IsPublic) - |> Seq.filter (fun ci -> - ( - let parameters = ci.GetParameters() - (parameters.Length = parameterTypes.Length) && - (parameterTypes, parameters) ||> Array.forall2 (fun ty pi -> pi.ParameterType.Equals ty) - ) - ) - |> Seq.toArray - |> commit - - member this.GetConstructor(parameterTypes : Type[]) = - this.GetConstructor(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance, parameterTypes) - - member this.GetConstructors(?bindingFlags) = - let bindingFlags = defaultArg bindingFlags (BindingFlags.Public ||| BindingFlags.Instance) - // type initializer will also be included in resultset - this.GetTypeInfo().DeclaredConstructors - |> Seq.filter (fun ci -> isAcceptable bindingFlags ci.IsStatic ci.IsPublic) - |> Seq.toArray - - // MSDN: returns an array of Type objects representing all the interfaces implemented or inherited by the current Type. - member this.GetInterfaces() = this.GetTypeInfo().ImplementedInterfaces |> Seq.toArray - - member this.GetMethods() = this.GetMethods(publicFlags) - - member this.Assembly = this.GetTypeInfo().Assembly - - member this.IsSubclassOf(otherTy : Type) = this.GetTypeInfo().IsSubclassOf(otherTy) - - member this.IsEnum = this.GetTypeInfo().IsEnum; - - member this.GetField(name, bindingFlags) = - this.GetFields(bindingFlags) - |> Array.filter (fun fi -> fi.Name = name) - |> commit - - member this.GetField(name) = RuntimeReflectionExtensions.GetRuntimeField(this, name) - - member this.GetProperty(name, propertyType, parameterTypes : Type[]) = - this.GetProperties() - |> Array.filter (fun pi -> - pi.Name = name && - pi.PropertyType = propertyType && - ( - let parameters = pi.GetIndexParameters() - (parameters.Length = parameterTypes.Length) && - (parameterTypes, parameters) ||> Array.forall2 (fun ty pi -> pi.ParameterType.Equals ty) - ) - ) - |> commit - - static member GetTypeCode(ty : Type) = - if typeof.Equals ty then TypeCode.Int32 - elif typeof.Equals ty then TypeCode.Int64 - elif typeof.Equals ty then TypeCode.Byte - elif ty = typeof then TypeCode.SByte - elif ty = typeof then TypeCode.Int16 - elif ty = typeof then TypeCode.UInt16 - elif ty = typeof then TypeCode.UInt32 - elif ty = typeof then TypeCode.UInt64 - elif ty = typeof then TypeCode.Single - elif ty = typeof then TypeCode.Double - elif ty = typeof then TypeCode.Decimal - else TypeCode.Object - - member this.Module = - this.GetTypeInfo().Module - - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = String.Format("{0}", this.ToString()) - s.GetHashCode() - - type System.Reflection.EventInfo with - - member this.GetAddMethod() = - this.AddMethod - - member this.GetRemoveMethod() = - this.RemoveMethod - - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = String.Format("{0},{0}", this.DeclaringType.ToString(), this.ToString()) - s.GetHashCode() - - type System.Reflection.FieldInfo with - member this.GetRawConstantValue() = - this.GetValue(null) - - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = String.Format("{0},{0}", this.DeclaringType.ToString(), this.ToString()) - s.GetHashCode() - - type System.Reflection.MemberInfo with - member this.GetCustomAttributes(attrTy, inherits) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this, attrTy, inherits) |> Seq.toArray) - - // TODO: is this an adequate replacement for MetadataToken - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = String.Format("{0},{0}", this.DeclaringType.ToString(), this.ToString()) - s.GetHashCode() - - type System.Reflection.MethodInfo with - - member this.GetCustomAttributes(inherits : bool) : obj[] = downcast box(CustomAttributeExtensions.GetCustomAttributes(this, inherits) |> Seq.toArray) - - member this.Invoke(obj, _bindingFlags, _binder, args, _ci) = - this.Invoke(obj, args) - - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = String.Format("{0},{0}", this.DeclaringType.ToString(), this.ToString()) - s.GetHashCode() - - type System.Reflection.ParameterInfo with - - member this.RawDefaultValue = this.DefaultValue - - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - // I really do not understand why: sprintf "%s,%s" (this.ReflectedType.ToString()) (this.ToString()) did not work - let s = String.Format("{0},{0},{0}", this.Member.DeclaringType.ToString(),this.Member.ToString(), this.ToString()) - s.GetHashCode() - - type System.Reflection.PropertyInfo with - - member this.GetGetMethod(nonPublic) = - let mi = this.GetMethod - if canUseAccessor mi nonPublic then mi - else null - - member this.GetSetMethod(nonPublic) = - let mi = this.SetMethod - if canUseAccessor mi nonPublic then mi - else null - - member this.GetGetMethod() = this.GetMethod - - member this.GetSetMethod() = this.SetMethod - - type System.Reflection.Assembly with - - member this.GetTypes() = - this.DefinedTypes - |> Seq.map (fun ti -> ti.AsType()) - |> Seq.toArray - - member this.GetExportedTypes() = - this.DefinedTypes - |> Seq.filter(fun ti -> ti.IsPublic) - |> Seq.map (fun ti -> ti.AsType()) - |> Seq.toArray - - member this.Location = - this.ManifestModule.FullyQualifiedName - - type System.Delegate with - - static member CreateDelegate(delegateType, methodInfo : MethodInfo) = methodInfo.CreateDelegate(delegateType) - - static member CreateDelegate(delegateType, obj : obj, methodInfo : MethodInfo) = methodInfo.CreateDelegate(delegateType, obj) - - type System.Object with - member this.GetPropertyValue(propName) = - this.GetType().GetProperty(propName, BindingFlags.Public).GetValue(this, null) - - member this.SetPropertyValue(propName, propValue) = - this.GetType().GetProperty(propName, BindingFlags.Public).SetValue(this, propValue, null) - - member this.GetMethod(methodName, argTypes) = - this.GetType().GetMethod(methodName, argTypes, BindingFlags.Public) - - type System.Char with - static member GetUnicodeCategory(c: char) = System.Globalization.CharUnicodeInfo.GetUnicodeCategory(c) - - type System.Reflection.Module with - member this.MetadataToken = - // TODO: is this an adequate replacement for MetadataToken - let s = this.FullyQualifiedName - s.GetHashCode() - -#if COMPILER // This part includes global state in globalLoadContext. Only include this support "once", i.e. when compiling FSharp.Compiler.Private.dll, FSharp.Compiler.Service.dll, fsc-proto.exe - - type CustomAssemblyResolver() = - inherit System.Runtime.Loader.AssemblyLoadContext() - override this.Load (assemblyName:AssemblyName):Assembly = - this.LoadFromAssemblyName(assemblyName) - - 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() :> System.Runtime.Loader.AssemblyLoadContext - | _ -> System.Runtime.Loader.AssemblyLoadContext.Default - - type System.Reflection.Assembly with - static member LoadFrom(filename:string) = - globalLoadContext.LoadFromAssemblyPath(filename) - - static member UnsafeLoadFrom(filename:string) = - globalLoadContext.LoadFromAssemblyPath(filename) - - type System.Reflection.AssemblyName with - static member GetAssemblyName(path) = - System.Runtime.Loader.AssemblyLoadContext.GetAssemblyName(path) - -#endif - -#endif diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index 228f4aba39..42cb18fa8d 100755 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -38,11 +38,6 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl open Microsoft.FSharp.Collections open Microsoft.FSharp.Primitives.Basics -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open ReflectionAdapters -#endif - [] type LayoutTag = | ActivePatternCase @@ -321,11 +316,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl StringLimit : int; #endif FormatProvider: System.IFormatProvider; -#if FX_RESHAPED_REFLECTION - ShowNonPublic : bool -#else BindingFlags: System.Reflection.BindingFlags -#endif PrintWidth : int; PrintDepth : int; PrintLength : int; @@ -339,11 +330,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl StringLimit = System.Int32.MaxValue; #endif AttributeProcessor= (fun _ _ _ -> ()); -#if FX_RESHAPED_REFLECTION - ShowNonPublic = false -#else BindingFlags = System.Reflection.BindingFlags.Public; -#endif FloatingPointFormat = "g10"; PrintWidth = 80 ; PrintDepth = 100 ; @@ -358,11 +345,6 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl open System open System.Reflection -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - [] type TypeInfo = | TupleType of Type list @@ -404,10 +386,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // Analyze an object to see if it the representation // of an F# value. - let GetValueInfoOfObject (bindingFlags:BindingFlags) (obj : obj) = -#if FX_RESHAPED_REFLECTION - let showNonPublic = isNonPublicFlag bindingFlags -#endif + let GetValueInfoOfObject (bindingFlags:BindingFlags) (obj : obj) = match obj with | null -> ObjectValue(obj) | _ -> @@ -429,34 +408,18 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // the type are the actual fields of the type. Again, // we should be reading attributes here that indicate the // true structure of the type, e.g. the order of the fields. -#if FX_RESHAPED_REFLECTION - elif FSharpType.IsUnion(reprty, showNonPublic) then - let tag,vals = FSharpValue.GetUnionFields (obj,reprty, showNonPublic) -#else elif FSharpType.IsUnion(reprty,bindingFlags) then let tag,vals = FSharpValue.GetUnionFields (obj,reprty,bindingFlags) -#endif let props = tag.GetFields() let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,(v, prop.PropertyType)) ConstructorValue(tag.Name, Array.toList pvals) -#if FX_RESHAPED_REFLECTION - elif FSharpType.IsExceptionRepresentation(reprty, showNonPublic) then - let props = FSharpType.GetExceptionFields(reprty, showNonPublic) - let vals = FSharpValue.GetExceptionFields(obj, showNonPublic) -#else elif FSharpType.IsExceptionRepresentation(reprty,bindingFlags) then let props = FSharpType.GetExceptionFields(reprty,bindingFlags) let vals = FSharpValue.GetExceptionFields(obj,bindingFlags) -#endif let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,(v, prop.PropertyType)) ExceptionValue(reprty, pvals |> Array.toList) -#if FX_RESHAPED_REFLECTION - elif FSharpType.IsRecord(reprty, showNonPublic) then - let props = FSharpType.GetRecordFields(reprty, showNonPublic) -#else elif FSharpType.IsRecord(reprty,bindingFlags) then let props = FSharpType.GetRecordFields(reprty,bindingFlags) -#endif RecordValue(props |> Array.map (fun prop -> prop.Name, prop.GetValue(obj,null), prop.PropertyType) |> Array.toList) else ObjectValue(obj) @@ -491,12 +454,8 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl let string_of_int (i:int) = i.ToString() let typeUsesSystemObjectToString (ty:System.Type) = - try -#if FX_RESHAPED_REFLECTION - let methInfo = ty.GetRuntimeMethod("ToString",[| |]) -#else + try let methInfo = ty.GetMethod("ToString",BindingFlags.Public ||| BindingFlags.Instance,null,[| |],null) -#endif methInfo.DeclaringType = typeof with e -> false /// If "str" ends with "ending" then remove it from "str", otherwise no change. @@ -796,16 +755,8 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // -------------------------------------------------------------------- let getProperty (ty: Type) (obj: obj) name = -#if FX_RESHAPED_REFLECTION - let prop = ty.GetProperty(name, (BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic)) - if not (isNull prop) then prop.GetValue(obj,[||]) - // Others raise MissingMethodException - else - let msg = System.String.Concat([| "Method '"; ty.FullName; "."; name; "' not found." |]) - raise (System.MissingMethodException(msg)) -#else ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, [| |],CultureInfo.InvariantCulture) -#endif + let getField obj (fieldInfo: FieldInfo) = fieldInfo.GetValue(obj) @@ -1173,11 +1124,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // If the leafFormatter was directly here, then layout leaves could store strings. match obj with | _ when opts.ShowProperties -> -#if FX_RESHAPED_REFLECTION - let props = ty.GetProperties(BindingFlags.Instance ||| BindingFlags.Public) -#else let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public) -#endif let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) |> Array.map (fun i -> i :> MemberInfo) let propsAndFields = props |> Array.map (fun i -> i :> MemberInfo) @@ -1193,10 +1140,10 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // massively reign in deep printing of properties let nDepth = depthLim/10 #if NETSTANDARD - Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); -#else - Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); -#endif + Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ) +#else + Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ) +#endif if propsAndFields.Length = 0 || (nDepth <= 0) then basicL else basicL --- @@ -1307,12 +1254,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl let fsi_any_to_layout opts x = anyL ShowTopLevelBinding BindingFlags.Public opts x #else // FSharp.Core -#if FX_RESHAPED_REFLECTION - let internal anyToStringForPrintf options (showNonPublicMembers : bool) x = - let bindingFlags = ReflectionUtils.toBindingFlags showNonPublicMembers -#else let internal anyToStringForPrintf options (bindingFlags:BindingFlags) x = -#endif x |> anyL ShowAll bindingFlags options |> layout_to_string options #endif diff --git a/src/utils/sformat.fsi b/src/utils/sformat.fsi index f7c053e51f..e6ff9762bb 100755 --- a/src/utils/sformat.fsi +++ b/src/utils/sformat.fsi @@ -302,11 +302,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl StringLimit: int; #endif FormatProvider: System.IFormatProvider -#if FX_RESHAPED_REFLECTION - ShowNonPublic : bool -#else BindingFlags: System.Reflection.BindingFlags -#endif PrintWidth : int PrintDepth : int PrintLength : int @@ -341,11 +337,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl #if FSHARP_CORE // FSharp.Core.dll: Most functions aren't needed in FSharp.Core.dll, but we add one entry for printf -#if FX_RESHAPED_REFLECTION - val anyToStringForPrintf: options:FormatOptions -> showNonPublicMembers : bool -> value:'T * Type -> string -#else val anyToStringForPrintf: options:FormatOptions -> bindingFlags:System.Reflection.BindingFlags -> value:'T * Type -> string -#endif #else val asTaggedTextWriter: writer: TextWriter -> TaggedTextWriter val any_to_layout : options:FormatOptions -> value:'T * Type -> Layout diff --git a/tests/projects/Sample_NETCoreSDK_FSharp_Library_netstandard1.6/Sample_NETCoreSDK_FSharp_Library_netstandard1.6.fsproj b/tests/projects/Sample_NETCoreSDK_FSharp_Library_netstandard1.6/Sample_NETCoreSDK_FSharp_Library_netstandard1.6.fsproj index abac283cf0..a237159916 100644 --- a/tests/projects/Sample_NETCoreSDK_FSharp_Library_netstandard1.6/Sample_NETCoreSDK_FSharp_Library_netstandard1.6.fsproj +++ b/tests/projects/Sample_NETCoreSDK_FSharp_Library_netstandard1.6/Sample_NETCoreSDK_FSharp_Library_netstandard1.6.fsproj @@ -1,6 +1,6 @@ - netstandard1.6 + netstandard2.0 diff --git a/tests/projects/stress/Templates/fsproj.template b/tests/projects/stress/Templates/fsproj.template index 2e87b3a4a8..9af6ff1673 100644 --- a/tests/projects/stress/Templates/fsproj.template +++ b/tests/projects/stress/Templates/fsproj.template @@ -36,7 +36,7 @@ - ..\packages\FSharp.Core.4.6.2\lib\net45\FSharp.Core.dll + ..\packages\FSharp.Core.4.7.0\lib\net45\FSharp.Core.dll diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 0ec9aa2ab3..6920e682af 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -6,10 +6,6 @@ open System.Collections.Generic open FSharp.Compiler open FSharp.Compiler.SourceCodeServices -#if FX_RESHAPED_REFLECTION -open ReflectionAdapters -#endif - #if NETCOREAPP2_0 let readRefs (folder : string) (projectFile: string) = let runProcess (workingDir: string) (exePath: string) (args: string) = @@ -71,14 +67,10 @@ let sysLib nm = #if !NETCOREAPP2_0 if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows let programFilesx86Folder = System.Environment.GetEnvironmentVariable("PROGRAMFILES(X86)") - programFilesx86Folder + @"\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.6.1\" + nm + ".dll" + programFilesx86Folder + @"\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.7.2\" + nm + ".dll" else #endif -#if FX_NO_RUNTIMEENVIRONMENT let sysDir = System.AppContext.BaseDirectory -#else - let sysDir = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() -#endif let (++) a b = System.IO.Path.Combine(a,b) sysDir ++ nm + ".dll" diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index 63406f09cb..69b9e40764 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -1288,16 +1288,6 @@ let ``Test TPProject param info`` () = #endif // TEST_TP_PROJECTS -#if EXE - -``Intro test`` () -//``Test TPProject all symbols`` () -//``Test TPProject errors`` () -//``Test TPProject quick info`` () -//``Test TPProject param info`` () -``Basic cancellation test`` () -``Intro test`` () -#endif [] let ``FSharpField.IsNameGenerated`` () = diff --git a/tests/service/FscTests.fs b/tests/service/FscTests.fs index 9bedfd38b1..b7ff870675 100644 --- a/tests/service/FscTests.fs +++ b/tests/service/FscTests.fs @@ -20,10 +20,6 @@ open FSharp.Compiler.Service.Tests.Common open NUnit.Framework -#if FX_RESHAPED_REFLECTION -open ReflectionAdapters -#endif - exception VerificationException of (*assembly:*)string * (*errorCode:*)int * (*output:*)string with override e.Message = sprintf "Verification of '%s' failed with code %d, message <<<%s>>>" e.Data0 e.Data1 e.Data2 diff --git a/tests/service/ReshapedReflection.fs b/tests/service/ReshapedReflection.fs deleted file mode 100644 index 3b1ba07ce8..0000000000 --- a/tests/service/ReshapedReflection.fs +++ /dev/null @@ -1,9 +0,0 @@ -namespace FSharp.Compiler.Service.Tests - -#if FX_RESHAPED_REFLECTION -module internal ReflectionAdapters = - open System.Reflection - - type System.Type with - member this.Assembly = this.GetTypeInfo().Assembly -#endif diff --git a/tests/service/data/samename/tempet.fsproj b/tests/service/data/samename/tempet.fsproj index 682a3ec1a3..03da397c8d 100644 --- a/tests/service/data/samename/tempet.fsproj +++ b/tests/service/data/samename/tempet.fsproj @@ -1,6 +1,6 @@ - netstandard1.6 + netstandard2.0